- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 20 edited
-
eosbn2.F90 (modified) (12 diffs)
-
traadv.F90 (modified) (5 diffs)
-
traadv_cen2.F90 (modified) (2 diffs)
-
traadv_eiv.F90 (modified) (5 diffs)
-
traadv_muscl.F90 (modified) (3 diffs)
-
traadv_muscl2.F90 (modified) (1 diff)
-
traadv_qck.F90 (modified) (1 diff)
-
traadv_tvd.F90 (modified) (15 diffs)
-
traadv_ubs.F90 (modified) (1 diff)
-
trabbl.F90 (modified) (5 diffs)
-
traldf.F90 (modified) (2 diffs)
-
traldf_bilap.F90 (modified) (1 diff)
-
traldf_bilapg.F90 (modified) (2 diffs)
-
traldf_iso.F90 (modified) (6 diffs)
-
traldf_iso_grif.F90 (modified) (1 diff)
-
traldf_lap.F90 (modified) (1 diff)
-
tranxt.F90 (modified) (13 diffs)
-
traqsr.F90 (modified) (12 diffs)
-
trasbc.F90 (modified) (5 diffs)
-
trazdf.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r7960 r9987 22 22 !! - ! 2013-04 (F. Roquet, G. Madec) add eos_rab, change bn2 computation and reorganize the module 23 23 !! - ! 2014-09 (F. Roquet) add TEOS-10, S-EOS, and modify EOS-80 24 !! - ! 2015-06 (P.A. Bouttier) eos_fzp functions changed to subroutines for AGRIF 24 25 !!---------------------------------------------------------------------- 25 26 … … 311 312 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 312 313 ! ! 2 : salinity [psu] 313 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( 314 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( 314 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: prd ! in situ density [-] 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: prhop ! potential density (surface referenced) 315 316 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 316 317 ! … … 456 457 END SELECT 457 458 ! 459 CALL lbc_lnk( prd, 'T', 1.0_wp ) 460 ! 458 461 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 459 462 ! … … 901 904 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celcius,psu] 902 905 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celcius-1,psu-1] 903 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( 906 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 904 907 ! 905 908 INTEGER :: ji, jj, jk ! dummy loop indices … … 991 994 992 995 993 FUNCTION eos_fzp_2d( psal, pdep ) RESULT( ptf)996 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 994 997 !!---------------------------------------------------------------------- 995 998 !! *** ROUTINE eos_fzp *** … … 1005 1008 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1006 1009 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1007 REAL(wp), DIMENSION(jpi,jpj) :: ptf! freezing temperature [Celcius]1010 REAL(wp), DIMENSION(jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celcius] 1008 1011 ! 1009 1012 INTEGER :: ji, jj ! dummy loop indices … … 1017 1020 DO jj = 1, jpj 1018 1021 DO ji = 1, jpi 1019 zs= SQRT( ABS( psal(ji,jj) ) * r1_S0) ! square root salinity1022 zs= SQRT( ABS( psal(ji,jj) ) / 35.16504_wp ) ! square root salinity 1020 1023 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1021 1024 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp … … 1038 1041 nstop = nstop + 1 1039 1042 ! 1040 END SELECT 1041 ! 1042 END FUNCTIONeos_fzp_2d1043 1044 FUNCTION eos_fzp_0d( psal, pdep ) RESULT( ptf)1043 END SELECT 1044 ! 1045 END SUBROUTINE eos_fzp_2d 1046 1047 SUBROUTINE eos_fzp_0d( psal, ptf, pdep ) 1045 1048 !!---------------------------------------------------------------------- 1046 1049 !! *** ROUTINE eos_fzp *** … … 1054 1057 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 1055 1058 !!---------------------------------------------------------------------- 1056 REAL(wp), INTENT(in ) :: psal! salinity [psu]1057 REAL(wp), INTENT(in ), OPTIONAL :: pdep! depth [m]1058 REAL(wp) :: ptf! freezing temperature [Celcius]1059 REAL(wp), INTENT(in ) :: psal ! salinity [psu] 1060 REAL(wp), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1061 REAL(wp), INTENT(out) :: ptf ! freezing temperature [Celcius] 1059 1062 ! 1060 1063 REAL(wp) :: zs ! local scalars … … 1065 1068 CASE ( -1, 1 ) !== CT,SA (TEOS-10 formulation) ==! 1066 1069 ! 1067 zs = SQRT( ABS( psal ) * r1_S0) ! square root salinity1070 zs = SQRT( ABS( psal ) / 35.16504_wp ) ! square root salinity 1068 1071 ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1069 1072 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp … … 1086 1089 END SELECT 1087 1090 ! 1088 END FUNCTIONeos_fzp_0d1091 END SUBROUTINE eos_fzp_0d 1089 1092 1090 1093 … … 1255 1258 WRITE(numout,*) ' model does not use Conservative Temperature' 1256 1259 ENDIF 1260 ENDIF 1261 ! 1262 ! Consistency check on ln_useCT and nn_eos 1263 IF ((nn_eos .EQ. -1) .AND. (.NOT. ln_useCT)) THEN 1264 CALL ctl_stop("ln_useCT should be set to True if using TEOS-10 (nn_eos=-1)") 1265 ELSE IF ((nn_eos .NE. -1) .AND. (ln_useCT)) THEN 1266 CALL ctl_stop("ln_useCT should be set to False if using TEOS-80 or simplified equation of state (nn_eos=0 or nn_eos=1)") 1257 1267 ENDIF 1258 1268 ! -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r7960 r9987 26 26 USE cla ! cross land advection (cla_traadv routine) 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE trd_oce ! trends: ocean variables 29 USE trdtra ! trends manager: tracers 28 30 ! 29 31 USE in_out_manager ! I/O manager … … 78 80 ! 79 81 INTEGER :: jk ! dummy loop index 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zun, zvn, zwn 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 81 84 !!---------------------------------------------------------------------- 82 85 ! 83 86 IF( nn_timing == 1 ) CALL timing_start('tra_adv') 84 87 ! 85 CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 88 ALLOCATE(zun(1:jpi, 1:jpj, 1:jpk)) 89 ALLOCATE(zvn(1:jpi, 1:jpj, 1:jpk)) 90 ALLOCATE(zwn(1:jpi, 1:jpj, 1:jpk)) 86 91 ! ! set time step 87 92 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 … … 120 125 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 121 126 ! 122 127 IF( l_trdtra ) THEN !* Save ta and sa trends 128 ALLOCATE(ztrdt( 1:jpi, 1:jpj, 1:jpk) ) 129 ALLOCATE(ztrds( 1:jpi, 1:jpj, 1:jpk) ) 130 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 131 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 132 ENDIF 133 ! 123 134 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 124 135 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered … … 151 162 END SELECT 152 163 ! 164 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 165 DO jk = 1, jpkm1 166 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 167 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 168 END DO 169 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 170 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 171 DEALLOCATE (ztrdt) 172 DEALLOCATE (ztrds) 173 ENDIF 153 174 ! ! print mean trends (used for debugging) 154 175 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & … … 157 178 IF( nn_timing == 1 ) CALL timing_stop( 'tra_adv' ) 158 179 ! 159 CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 180 DEALLOCATE(zun) 181 DEALLOCATE(zvn) 182 DEALLOCATE(zwn) 160 183 ! 161 184 END SUBROUTINE tra_adv -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r7960 r9987 173 173 END DO 174 174 END DO 175 zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal), zpres(:,:) )175 CALL eos_fzp( tsn(:,:,1,jp_sal), zfzp(:,:), zpres(:,:) ) 176 176 DO jk = 1, jpk 177 177 DO jj = 1, jpj … … 279 279 END IF 280 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 281 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 282 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 283 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 284 ENDIF 281 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 285 282 ! 286 283 END DO -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r7960 r9987 28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing 30 USE diaptr ! Heat/Salt transport diagnostics 31 USE trddyn 32 USE trd_oce 30 33 31 34 IMPLICIT NONE … … 78 81 # endif 79 82 REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 80 84 !!---------------------------------------------------------------------- 81 85 ! … … 84 88 # if defined key_diaeiv 85 89 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 90 CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 86 91 # else 87 92 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) … … 160 165 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 161 166 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 162 IF( iom_use('ueiv_heattr') ) THEN 163 zztmp = 0.5 * rau0 * rcp 167 IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value 168 z2d(:,:) = rau0 * e12t(:,:) 169 DO jk = 1, jpk 170 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 171 END DO 172 CALL iom_put( "weiv_masstr" , z3d ) 173 ENDIF 174 IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d') & 175 .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 176 z3d(:,:,jpk) = 0.e0 177 z2d(:,:) = 0.e0 178 DO jk = 1, jpkm1 179 z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 180 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 181 END DO 182 CALL iom_put( "ueiv_masstr", z3d ) ! mass transport in i-direction 183 ENDIF 184 185 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 186 zztmp = 0.5 * rcp 164 187 z2d(:,:) = 0.e0 165 DO jk = 1, jpkm1 166 DO jj = 2, jpjm1 167 DO ji = fs_2, fs_jpim1 ! vector opt. 168 z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 169 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk) 170 END DO 171 END DO 172 END DO 173 CALL lbc_lnk( z2d, 'U', -1. ) 174 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! heat transport in i-direction 188 z3d_T(:,:,:) = 0.e0 189 DO jk = 1, jpkm1 190 DO jj = 2, jpjm1 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 193 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 194 END DO 195 END DO 196 END DO 197 IF (iom_use('ueiv_heattr') ) THEN 198 CALL lbc_lnk( z2d, 'U', -1. ) 199 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! 2D heat transport in i-direction 200 ENDIF 201 IF (iom_use('ueiv_heattr3d') ) THEN 202 CALL lbc_lnk( z3d_T, 'U', -1. ) 203 CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in i-direction 204 ENDIF 205 ENDIF 206 207 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 208 zztmp = 0.5 * 0.001 209 z2d(:,:) = 0.e0 210 z3d_T(:,:,:) = 0.e0 211 DO jk = 1, jpkm1 212 DO jj = 2, jpjm1 213 DO ji = fs_2, fs_jpim1 ! vector opt. 214 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 215 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 216 END DO 217 END DO 218 END DO 219 IF (iom_use('ueiv_salttr') ) THEN 220 CALL lbc_lnk( z2d, 'U', -1. ) 221 CALL iom_put( "ueiv_salttr", zztmp * z2d ) ! 2D salt transport in i-direction 222 ENDIF 223 IF (iom_use('ueiv_salttr3d') ) THEN 224 CALL lbc_lnk( z3d_T, 'U', -1. ) 225 CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in i-direction 226 ENDIF 227 ENDIF 228 229 IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d') & 230 .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 231 z3d(:,:,jpk) = 0.e0 232 DO jk = 1, jpkm1 233 z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 234 END DO 235 CALL iom_put( "veiv_masstr", z3d ) ! mass transport in j-direction 175 236 ENDIF 176 237 177 IF( iom_use('veiv_heattr') ) THEN178 zztmp = 0.5 * r au0 * rcp238 IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 239 zztmp = 0.5 * rcp 179 240 z2d(:,:) = 0.e0 180 DO jk = 1, jpkm1 181 DO jj = 2, jpjm1 182 DO ji = fs_2, fs_jpim1 ! vector opt. 183 z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 184 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk) 185 END DO 186 END DO 187 END DO 188 CALL lbc_lnk( z2d, 'V', -1. ) 189 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! heat transport in i-direction 190 ENDIF 241 z3d_T(:,:,:) = 0.e0 242 DO jk = 1, jpkm1 243 DO jj = 2, jpjm1 244 DO ji = fs_2, fs_jpim1 ! vector opt. 245 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 246 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 247 END DO 248 END DO 249 END DO 250 IF (iom_use('veiv_heattr') ) THEN 251 CALL lbc_lnk( z2d, 'V', -1. ) 252 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! 2D heat transport in j-direction 253 ENDIF 254 IF (iom_use('veiv_heattr3d') ) THEN 255 CALL lbc_lnk( z3d_T, 'V', -1. ) 256 CALL iom_put( "veiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in j-direction 257 ENDIF 258 ENDIF 259 260 IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 261 zztmp = 0.5 * 0.001 262 z2d(:,:) = 0.e0 263 z3d_T(:,:,:) = 0.e0 264 DO jk = 1, jpkm1 265 DO jj = 2, jpjm1 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 268 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 269 END DO 270 END DO 271 END DO 272 IF (iom_use('veiv_salttr') ) THEN 273 CALL lbc_lnk( z2d, 'V', -1. ) 274 CALL iom_put( "veiv_salttr", zztmp * z2d ) ! 2D salt transport in i-direction 275 ENDIF 276 IF (iom_use('veiv_salttr3d') ) THEN 277 CALL lbc_lnk( z3d_T, 'V', -1. ) 278 CALL iom_put( "veiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in i-direction 279 ENDIF 280 ENDIF 281 282 IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN ! vertical mass transport & its square value 283 z2d(:,:) = rau0 * e12t(:,:) 284 DO jk = 1, jpk 285 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 286 END DO 287 CALL iom_put( "weiv_masstr" , z3d ) ! mass transport in k-direction 288 ENDIF 289 290 IF( iom_use('weiv_heattr3d') ) THEN 291 zztmp = 0.5 * rcp 292 DO jk = 1, jpkm1 293 DO jj = 2, jpjm1 294 DO ji = fs_2, fs_jpim1 ! vector opt. 295 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 296 END DO 297 END DO 298 END DO 299 CALL lbc_lnk( z3d_T, 'T', 1. ) 300 CALL iom_put( "weiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in k-direction 301 ENDIF 302 303 IF( iom_use('weiv_salttr3d') ) THEN 304 zztmp = 0.5 * 0.001 305 DO jk = 1, jpkm1 306 DO jj = 2, jpjm1 307 DO ji = fs_2, fs_jpim1 ! vector opt. 308 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 309 END DO 310 END DO 311 END DO 312 CALL lbc_lnk( z3d_T, 'T', 1. ) 313 CALL iom_put( "weiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in k-direction 314 ENDIF 315 191 316 END IF 317 ! 318 IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 319 z3d(:,:,:) = 0._wp 320 DO jk = 1, jpkm1 321 DO jj = 2, jpjm1 322 DO ji = fs_2, fs_jpim1 ! vector opt. 323 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 324 & * e1v(ji,jj) * fse3v(ji,jj,jk) 325 END DO 326 END DO 327 END DO 328 CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 329 z3d(:,:,:) = 0._wp 330 DO jk = 1, jpkm1 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 ! vector opt. 333 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 334 & * e1v(ji,jj) * fse3v(ji,jj,jk) 335 END DO 336 END DO 337 END DO 338 CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 339 ENDIF 340 341 IF( ln_KE_trd ) CALL trd_dyn(u_eiv, v_eiv, jpdyn_eivke, kt ) 192 342 # endif 193 ! 343 194 344 # if defined key_diaeiv 195 345 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 346 CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 196 347 # else 197 348 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) … … 212 363 CHARACTER(len=3) :: cdtype 213 364 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn 214 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 365 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', & 366 & kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 215 367 END SUBROUTINE tra_adv_eiv 216 368 #endif -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r7960 r9987 82 82 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 83 83 REAL(wp) :: ztra, zbtr, zdt, zalpha ! - - 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy ! 3D workspace85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx , zwy ! - -84 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zslpx, zslpy ! 3D workspace 85 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwx , zwy ! - - 86 86 !!---------------------------------------------------------------------- 87 87 ! 88 88 IF( nn_timing == 1 ) CALL timing_start('tra_adv_muscl') 89 89 ! 90 CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 90 ALLOCATE( zslpx(1:jpi, 1:jpj, 1:jpk) ) 91 ALLOCATE( zslpy(1:jpi, 1:jpj, 1:jpk) ) 92 ALLOCATE( zwx (1:jpi, 1:jpj, 1:jpk) ) 93 ALLOCATE( zwy (1:jpi, 1:jpj, 1:jpk) ) 91 94 ! 92 95 IF( kt == kit000 ) THEN … … 219 222 END IF 220 223 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 221 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 222 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 223 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 224 ENDIF 224 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 225 225 226 226 ! II. Vertical advective fluxes … … 291 291 END DO 292 292 ! 293 CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy, zwx, zwy ) 293 DEALLOCATE( zslpx ) 294 DEALLOCATE( zslpy ) 295 DEALLOCATE( zwx ) 296 DEALLOCATE( zwy ) 294 297 ! 295 298 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_muscl') -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r7960 r9987 200 200 201 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 202 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 203 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 204 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 205 ENDIF 202 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 206 203 207 204 ! II. Vertical advective fluxes -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r7960 r9987 355 355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 356 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 357 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 358 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 359 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 360 ENDIF 357 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 361 358 ! 362 359 END DO -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r7960 r9987 34 34 USE timing ! Timing 35 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 USE iom 36 37 37 38 IMPLICIT NONE … … 42 43 43 44 LOGICAL :: l_trd ! flag to compute trends 45 LOGICAL :: l_trans ! flag to output vertically integrated transports 44 46 45 47 !! * Substitutions … … 84 86 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk ! - - 85 87 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwi, zwz 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 90 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d 88 91 !!---------------------------------------------------------------------- 89 92 ! 90 93 IF( nn_timing == 1 ) CALL timing_start('tra_adv_tvd') 91 94 ! 92 CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz ) 95 ALLOCATE(zwi(1:jpi, 1:jpj, 1:jpk)) 96 ALLOCATE(zwz(1:jpi, 1:jpj, 1:jpk)) 97 93 98 ! 94 99 IF( kt == kit000 ) THEN … … 97 102 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 98 103 ! 99 l_trd = .FALSE.100 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.101 104 ENDIF 102 ! 103 IF( l_trd ) THEN 104 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 105 l_trd = .FALSE. 106 l_trans = .FALSE. 107 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 108 IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 109 ! 110 IF( l_trd .OR. l_trans ) THEN 111 ALLOCATE(ztrdx(1:jpi, 1:jpj, 1:jpk)) 112 ALLOCATE(ztrdy(1:jpi, 1:jpj, 1:jpk)) 113 ALLOCATE(ztrdz(1:jpi, 1:jpj, 1:jpk)) 105 114 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 115 ALLOCATE(z2d(1:jpi, 1:jpj)) 116 ENDIF 117 ! 118 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 119 ALLOCATE(zptry(1:jpi, 1:jpj, 1:jpk)) 120 zptry(:,:,:) = 0._wp 106 121 ENDIF 107 122 ! … … 173 188 DO jj = 2, jpjm1 174 189 DO ji = fs_2, fs_jpim1 ! vector opt. 175 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )176 190 ! total intermediate advective trends 177 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &178 & 179 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))191 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 192 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 193 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 180 194 ! update and guess with monotonic sheme 181 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra* tmask(ji,jj,jk)182 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)195 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 196 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 183 197 END DO 184 198 END DO … … 188 202 189 203 ! ! trend diagnostics (contribution of upstream fluxes) 190 IF( l_trd ) THEN204 IF( l_trd .OR. l_trans ) THEN 191 205 ! store intermediate advective trends 192 206 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 193 207 END IF 194 208 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 195 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 196 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 197 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 198 ENDIF 209 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 199 210 200 211 ! 3. antidiffusive flux : high order minus low order … … 254 265 255 266 ! ! trend diagnostics (contribution of upstream fluxes) 256 IF( l_trd ) THEN267 IF( l_trd .OR. l_trans ) THEN 257 268 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 258 269 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 259 270 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 260 261 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 262 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 263 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 271 ENDIF 272 273 IF( l_trd ) THEN 274 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 275 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 276 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 264 277 END IF 265 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 278 279 IF( l_trans .AND. jn==jp_tem ) THEN 280 z2d(:,:) = 0._wp 281 DO jk = 1, jpkm1 282 DO jj = 2, jpjm1 283 DO ji = fs_2, fs_jpim1 ! vector opt. 284 z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 285 END DO 286 END DO 287 END DO 288 CALL lbc_lnk( z2d, 'U', -1. ) 289 CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! heat transport in i-direction 290 ! 291 z2d(:,:) = 0._wp 292 DO jk = 1, jpkm1 293 DO jj = 2, jpjm1 294 DO ji = fs_2, fs_jpim1 ! vector opt. 295 z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 296 END DO 297 END DO 298 END DO 299 CALL lbc_lnk( z2d, 'V', -1. ) 300 CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! heat transport in j-direction 301 ENDIF 302 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 266 303 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 267 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)268 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)304 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 305 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 269 306 ENDIF 270 307 ! 271 308 END DO 272 309 ! 273 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 274 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 310 DEALLOCATE( zwi ) 311 DEALLOCATE( zwz ) 312 IF( l_trd .OR. l_trans ) THEN 313 DEALLOCATE( ztrdx ) 314 DEALLOCATE( ztrdy ) 315 DEALLOCATE( ztrdz ) 316 DEALLOCATE( z2d ) 317 ENDIF 318 IF( cdtype == 'TRA' .AND. ln_diaptr ) DEALLOCATE( zptry ) 275 319 ! 276 320 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') … … 316 360 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk ! - - 317 361 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 318 REAL(wp), POINTER, DIMENSION(:,: ) :: zwx_sav , zwy_sav 319 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 320 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 321 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 362 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zwx_sav , zwy_sav 363 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 364 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 365 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zptry 366 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrs 322 367 !!---------------------------------------------------------------------- 323 368 ! 324 369 IF( nn_timing == 1 ) CALL timing_start('tra_adv_tvd_zts') 325 370 ! 326 CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav ) 327 CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts ) 328 CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs ) 371 ALLOCATE(zwx_sav(1:jpi, 1:jpj)) 372 ALLOCATE(zwy_sav(1:jpi, 1:jpj)) 373 ALLOCATE(zwi(1:jpi, 1:jpj, 1:jpk)) 374 ALLOCATE(zwz(1:jpi, 1:jpj, 1:jpk)) 375 ALLOCATE(zhdiv(1:jpi, 1:jpj, 1:jpk)) 376 ALLOCATE(zwz_sav(1:jpi, 1:jpj, 1:jpk)) 377 ALLOCATE(zwzts(1:jpi, 1:jpj, 1:jpk)) 378 ALLOCATE(ztrs(1:jpi, 1:jpj, 1:jpk, 1:kjpt+1)) 329 379 ! 330 380 IF( kt == kit000 ) THEN … … 338 388 ! 339 389 IF( l_trd ) THEN 340 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 390 ALLOCATE(ztrdx(1:jpi, 1:jpj, 1:jpk)) 391 ALLOCATE(ztrdy(1:jpi, 1:jpj, 1:jpk)) 392 ALLOCATE(ztrdz(1:jpi, 1:jpj, 1:jpk)) 341 393 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 394 ENDIF 395 ! 396 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 397 ALLOCATE(zptry(1:jpi, 1:jpj, 1:jpk)) 398 zptry(:,:,:) = 0._wp 342 399 ENDIF 343 400 ! … … 410 467 DO jj = 2, jpjm1 411 468 DO ji = fs_2, fs_jpim1 ! vector opt. 412 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )413 469 ! total intermediate advective trends 414 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &415 & 416 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))470 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 471 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 472 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 417 473 ! update and guess with monotonic sheme 418 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra419 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)474 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 475 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 420 476 END DO 421 477 END DO … … 430 486 END IF 431 487 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 432 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 433 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 434 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 435 ENDIF 488 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 436 489 437 490 ! 3. antidiffusive flux : high order minus low order 438 491 ! -------------------------------------------------- 439 492 ! antidiffusive flux on i and j 440 441 493 ! 442 494 DO jk = 1, jpkm1 443 495 ! 444 496 DO jj = 1, jpjm1 445 497 DO ji = 1, fs_jpim1 ! vector opt. … … 472 524 ! 473 525 ztrs(:,:,:,1) = ptb(:,:,:,jn) 526 ztrs(:,:,1,2) = ptb(:,:,1,jn) 527 ztrs(:,:,1,3) = ptb(:,:,1,jn) 474 528 zwzts(:,:,:) = 0._wp 475 529 … … 557 611 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 558 612 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 559 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)560 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)613 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 614 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 561 615 ENDIF 562 616 ! 563 617 END DO 564 618 ! 565 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts ) 566 CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs ) 567 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 568 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 619 DEALLOCATE(zwi) 620 DEALLOCATE(zwz) 621 DEALLOCATE(zhdiv) 622 DEALLOCATE(zwz_sav) 623 DEALLOCATE(zwzts) 624 DEALLOCATE(ztrs ) 625 DEALLOCATE(zwx_sav) 626 DEALLOCATE(zwy_sav ) 627 628 IF( l_trd ) THEN 629 DEALLOCATE(ztrdx) 630 DEALLOCATE(ztrdy) 631 DEALLOCATE(ztrdz) 632 END IF 633 634 IF( cdtype == 'TRA' .AND. ln_diaptr ) DEALLOCATE(zptry ) 569 635 ! 570 636 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd_zts') 571 637 ! 572 638 END SUBROUTINE tra_adv_tvd_zts 639 573 640 574 641 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) … … 593 660 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt ! local scalars 594 661 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 595 REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo662 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo 596 663 !!---------------------------------------------------------------------- 597 664 ! 598 665 IF( nn_timing == 1 ) CALL timing_start('nonosc') 599 666 ! 600 CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 667 ALLOCATE(zbetup(1:jpi, 1:jpj, 1:jpk)) 668 ALLOCATE(zbetdo(1:jpi, 1:jpj, 1:jpk)) 669 ALLOCATE(zbup(1:jpi, 1:jpj, 1:jpk)) 670 ALLOCATE(zbdo(1:jpi, 1:jpj, 1:jpk)) 601 671 ! 602 672 zbig = 1.e+40_wp … … 675 745 CALL lbc_lnk( paa, 'U', -1. ) ; CALL lbc_lnk( pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 676 746 ! 677 CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 747 DEALLOCATE(zbetup) 748 DEALLOCATE(zbetdo) 749 DEALLOCATE(zbup) 750 DEALLOCATE(zbdo) 678 751 ! 679 752 IF( nn_timing == 1 ) CALL timing_stop('nonosc') -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r7960 r9987 177 177 END IF 178 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 ENDIF 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 183 180 184 181 ! TVD scheme for the vertical direction -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7960 r9987 107 107 INTEGER, INTENT( in ) :: kt ! ocean time-step 108 108 ! 109 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds109 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 110 110 !!---------------------------------------------------------------------- 111 111 ! … … 113 113 ! 114 114 IF( l_trdtra ) THEN !* Save ta and sa trends 115 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 115 ALLOCATE( ztrdt (1:jpi, 1:jpj, 1:jpk)) 116 ALLOCATE( ztrds (1:jpi, 1:jpj, 1:jpk)) 116 117 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 117 118 ztrds(:,:,:) = tsa(:,:,:,jp_sal) … … 151 152 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 152 153 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 153 CALL wrk_dealloc( jpi, jpj, jpk,ztrdt, ztrds )154 DEALLOCATE( ztrdt, ztrds ) 154 155 ENDIF 155 156 ! … … 187 188 INTEGER :: ik ! local integers 188 189 REAL(wp) :: zbtr ! local scalars 189 REAL(wp), POINTER, DIMENSION(:,:) :: zptb190 REAL(wp), ALLOCATABLE , DIMENSION(:,:) :: zptb 190 191 !!---------------------------------------------------------------------- 191 192 ! 192 193 IF( nn_timing == 1 ) CALL timing_start('tra_bbl_dif') 193 194 ! 194 CALL wrk_alloc( jpi, jpj, zptb)195 ALLOCATE(zptb(1:jpi, 1:jpj)) 195 196 ! 196 197 DO jn = 1, kjpt ! tracer loop … … 217 218 END DO ! end tracer 218 219 ! ! =========== 219 CALL wrk_dealloc( jpi, jpj,zptb )220 DEALLOCATE( zptb ) 220 221 ! 221 222 IF( nn_timing == 1 ) CALL timing_stop('tra_bbl_dif') -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r7960 r9987 68 68 ! 69 69 rldf = 1 ! For active tracers the 70 r_fact_lap(:,:,:) = 1.0 70 71 71 72 IF( l_trdtra ) THEN !* Save ta and sa trends … … 214 215 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 215 216 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 217 IF( ln_traldf_grif .AND. ln_isfcav ) & 218 CALL ctl_stop( ' ice shelf and traldf_grif not tested') 216 219 IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & 217 220 CALL ctl_stop( ' eddy induced velocity on tracers', & -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r7960 r9987 173 173 ! 174 174 ! "zonal" mean lateral diffusive heat and salt transport 175 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 176 IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 177 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 178 ENDIF 175 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 179 176 ! ! =========== 180 177 END DO ! tracer loop -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r7960 r9987 247 247 ! ! =============== 248 248 ! "Poleward" diffusive heat or salt transport 249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 250 ! note sign is reversed to give down-gradient diffusive transports (#1043) 251 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 252 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 253 ENDIF 249 ! note sign is reversed to give down-gradient diffusive transports (#1043) 250 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 254 251 255 252 ! ! ************ ! ! =============== … … 330 327 END DO 331 328 ELSE 332 IF(lwp)WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht333 IF(lwp)WRITE(numout,*) ' We stop'334 STOP 'ldfght'329 WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht 330 WRITE(numout,*) ' We stop' 331 CALL ctl_stop( 'STOP', 'ldfght : unexpected kaht value') 335 332 ENDIF 336 333 ! ! =============== -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7960 r9987 26 26 USE ldfslp ! iso-neutral slopes 27 27 USE diaptr ! poleward transport diagnostics 28 USE trd_oce ! trends: ocean variables 29 USE trdtra ! trends manager: tracers 28 30 USE in_out_manager ! I/O manager 29 31 USE iom ! I/O library 30 32 USE phycst ! physical constants 31 33 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! Memory Allocation33 34 USE timing ! Timing 34 35 … … 105 106 INTEGER :: ji, jj, jk, jn ! dummy loop indices 106 107 INTEGER :: ikt 107 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 108 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 109 REAL(wp) :: zcoef0, zbtr, ztra ! - - 110 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw 108 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 109 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 110 REAL(wp) :: zcoef0, zbtr ! - - 111 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: z2d 112 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw 113 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: ztrax, ztray, ztraz 114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: ztrax_T, ztray_T, ztraz_T 112 115 !!---------------------------------------------------------------------- 113 116 ! 114 117 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso') 115 118 ! 116 CALL wrk_alloc( jpi, jpj, z2d ) 117 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 119 ALLOCATE( z2d(1:jpi, 1:jpj)) 120 ALLOCATE( zdit(1:jpi, 1:jpj, 1:jpk)) 121 ALLOCATE( zdjt(1:jpi, 1:jpj, 1:jpk)) 122 ALLOCATE( ztfw(1:jpi, 1:jpj, 1:jpk)) 123 ALLOCATE( zdkt(1:jpi, 1:jpj, 1:jpk)) 124 ALLOCATE( zdk1t(1:jpi, 1:jpj, 1:jpk)) 125 ALLOCATE( ztrax(1:jpi,1:jpj,1:jpk)) 126 ALLOCATE( ztray(1:jpi,1:jpj,1:jpk)) 127 ALLOCATE( ztraz(1:jpi,1:jpj,1:jpk) ) 128 IF( l_trdtra .and. cdtype == 'TRA' ) THEN 129 ALLOCATE( ztrax_T(1:jpi,1:jpj,1:jpk)) 130 ALLOCATE( ztray_T(1:jpi,1:jpj,1:jpk)) 131 ALLOCATE( ztraz_T(1:jpi,1:jpj,1:jpk)) 132 ENDIF 118 133 ! 119 134 … … 127 142 DO jn = 1, kjpt ! tracer loop 128 143 ! ! =========== 144 ztrax(:,:,:) = 0._wp ; ztray(:,:,:) = 0._wp ; ztraz(:,:,:) = 0._wp ; 129 145 ! 130 146 !!---------------------------------------------------------------------- … … 226 242 DO ji = fs_2, fs_jpim1 ! vector opt. 227 243 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 228 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk))229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra244 ztrax(ji,jj,jk) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) ) 245 ztray(ji,jj,jk) = zbtr * ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 230 246 END DO 231 247 END DO … … 234 250 ! ! =============== 235 251 ! 252 pta(:,:,:,jn) = pta(:,:,:,jn) + ztrax(:,:,:) + ztray(:,:,:) 253 ! 236 254 ! "Poleward" diffusive heat or salt transports (T-S case only) 237 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN238 255 ! note sign is reversed to give down-gradient diffusive transports (#1043) 239 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 240 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 241 ENDIF 256 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 242 257 243 258 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN … … 314 329 DO ji = fs_2, fs_jpim1 ! vector opt. 315 330 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 316 ztra = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 317 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 331 ztraz(ji,jj,jk) = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 318 332 END DO 319 333 END DO 320 334 END DO 335 pta(:,:,:,jn) = pta(:,:,:,jn) + ztraz(:,:,:) 321 336 ! 337 IF( l_trdtra .AND. cdtype == "TRA" .AND. jn .eq. 1 ) THEN ! save the temperature trends 338 ztrax_T(:,:,:) = ztrax(:,:,:) 339 ztray_T(:,:,:) = ztray(:,:,:) 340 ztraz_T(:,:,:) = ztraz(:,:,:) 341 ENDIF 342 IF( l_trdtrc .AND. cdtype == "TRC" ) THEN ! save the horizontal component of diffusive trends for further diagnostics 343 CALL trd_tra( kt, cdtype, jn, jptra_iso_x, ztrax ) 344 CALL trd_tra( kt, cdtype, jn, jptra_iso_y, ztray ) 345 CALL trd_tra( kt, cdtype, jn, jptra_iso_z1, ztraz ) ! This is the first part of the vertical component. 346 ENDIF 322 347 END DO 323 348 ! 324 CALL wrk_dealloc( jpi, jpj, z2d ) 325 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 349 IF( l_trdtra .AND. cdtype == "TRA" ) THEN ! save the horizontal component of diffusive trends for further diagnostics 350 CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_x, ztrax_T ) 351 CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_x, ztrax ) 352 CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_y, ztray_T ) 353 CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_y, ztray ) 354 CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_z1, ztraz_T ) ! This is the first part of the vertical component 355 CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_z1, ztraz ) ! 356 ENDIF 357 ! 358 DEALLOCATE( z2d ) 359 DEALLOCATE( zdit) 360 DEALLOCATE( zdjt) 361 DEALLOCATE( ztfw) 362 DEALLOCATE( zdkt ) 363 DEALLOCATE( zdk1t ) 364 DEALLOCATE( ztrax, ztray, ztraz ) 365 IF( l_trdtra .and. cdtype == 'TRA' ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T ) 326 366 ! 327 367 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r7960 r9987 386 386 ! 387 387 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 389 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 390 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 391 ENDIF 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 392 389 393 390 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r7960 r9987 154 154 ! 155 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 159 ENDIF 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 160 157 ! ! ================== 161 158 END DO ! end of tracer loop -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r7960 r9987 28 28 USE sbc_oce ! surface boundary condition: ocean 29 29 USE sbcrnf ! river runoffs 30 USE sbcisf ! ice shelf melting/freezing 30 31 USE zdf_oce ! ocean vertical mixing 31 32 USE domvvl ! variable volume … … 46 47 USE timing ! Timing 47 48 #if defined key_agrif 48 USE agrif_opa_update49 49 USE agrif_opa_interp 50 50 #endif … … 110 110 ! Update after tracer on domain lateral boundaries 111 111 ! 112 #if defined key_agrif 113 CALL Agrif_tra ! AGRIF zoom boundaries 114 #endif 115 ! 112 116 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign) 113 117 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) … … 115 119 #if defined key_bdy 116 120 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 117 #endif118 #if defined key_agrif119 CALL Agrif_tra ! AGRIF zoom boundaries120 121 #endif 121 122 … … 126 127 127 128 ! trends computation initialisation 128 IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter129 IF( l_trdtra ) THEN 129 130 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 130 ztrdt(:,:, :) = tsn(:,:,:,jp_tem)131 ztrds(:,:, :) = tsn(:,:,:,jp_sal)131 ztrdt(:,:,jpk) = 0._wp 132 ztrds(:,:,jpk) = 0._wp 132 133 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 133 134 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 134 135 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 135 136 ENDIF 137 ! total trend for the non-time-filtered variables. 138 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 139 IF( lk_vvl ) THEN 140 DO jk = 1, jpkm1 141 zfact = 1.0 / rdttra(jk) 142 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 143 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 144 END DO 145 ELSE 146 DO jk = 1, jpkm1 147 zfact = 1.0 / rdttra(jk) 148 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 149 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 150 END DO 151 END IF 152 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 153 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 154 IF( .NOT.lk_vvl ) THEN 155 ! Store now fields before applying the Asselin filter 156 ! in order to calculate Asselin filter trend later. 157 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 158 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 159 END IF 136 160 ENDIF 137 161 … … 142 166 END DO 143 167 END DO 168 IF (l_trdtra.AND.lk_vvl) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 169 ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 170 ztrdt(:,:,:) = 0._wp 171 ztrds(:,:,:) = 0._wp 172 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 173 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 174 END IF 144 175 ELSE ! Leap-Frog + Asselin filter time stepping 145 176 ! … … 148 179 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 149 180 ENDIF 150 ENDIF 151 ! 152 #if defined key_agrif 153 ! Update tracer at AGRIF zoom boundaries 154 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tra( kt ) ! children only 155 #endif 156 ! 157 ! trends computation 158 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 181 ENDIF 182 ! 183 ! trends computation 184 IF( l_trdtra.AND..NOT.lk_vvl) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 159 185 DO jk = 1, jpkm1 160 186 zfact = 1._wp / r2dtra(jk) … … 164 190 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 165 191 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 166 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )167 192 END IF 193 IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 168 194 ! 169 195 ! ! control print … … 279 305 280 306 !! 281 LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf ! local logical307 LOGICAL :: ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf ! local logical 282 308 INTEGER :: ji, jj, jk, jn ! dummy loop indices 283 REAL(wp) :: zfact 1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar309 REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 284 310 REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 311 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf 285 312 !!---------------------------------------------------------------------- 286 313 ! … … 295 322 ll_traqsr = ln_traqsr ! active tracers case and solar penetration 296 323 ll_rnf = ln_rnf ! active tracers case and river runoffs 324 IF (nn_isf .GE. 1) THEN 325 ll_isf = .TRUE. ! active tracers case and ice shelf melting/freezing 326 ELSE 327 ll_isf = .FALSE. 328 END IF 297 329 ELSE 298 330 ll_tra_hpg = .FALSE. ! passive tracers case or NO semi-implicit hpg 299 331 ll_traqsr = .FALSE. ! active tracers case and NO solar penetration 300 332 ll_rnf = .FALSE. ! passive tracers or NO river runoffs 301 ENDIF 302 ! 333 ll_isf = .FALSE. ! passive tracers or NO ice shelf melting/freezing 334 ENDIF 335 ! 336 IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN 337 CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 338 ztrd_atf(:,:,:,:) = 0.0_wp 339 ENDIF 303 340 DO jn = 1, kjpt 304 341 DO jk = 1, jpkm1 342 zfact = 1._wp / r2dtra(jk) 305 343 zfact1 = atfp * p2dt(jk) 306 344 zfact2 = zfact1 / rau0 … … 321 359 ztc_f = ztc_n + atfp * ztc_d 322 360 ! 323 IF( jk == 1 ) THEN ! first level 324 ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) + rnf(ji,jj) - rnf_b(ji,jj) ) 361 IF( jk == mikt(ji,jj) ) THEN ! first level 362 ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj) - emp(ji,jj) ) & 363 & - (rnf_b(ji,jj) - rnf(ji,jj) ) & 364 & + (fwfisf_b(ji,jj) - fwfisf(ji,jj)) ) 325 365 ztc_f = ztc_f - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) ) 326 366 ENDIF 327 367 328 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & ! solar penetration (temperature only) 368 ! solar penetration (temperature only) 369 IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr ) & 329 370 & ztc_f = ztc_f - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 330 371 331 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & ! river runoffs 372 ! river runoff 373 IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) ) & 332 374 & ztc_f = ztc_f - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 333 375 & * fse3t_n(ji,jj,jk) / h_rnf(ji,jj) 376 377 ! ice shelf 378 IF( ll_isf ) THEN 379 ! level fully include in the Losch_2008 ice shelf boundary layer 380 IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) ) & 381 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 382 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) 383 ! level partially include in Losch_2008 ice shelf boundary layer 384 IF ( jk == misfkb(ji,jj) ) & 385 ztc_f = ztc_f - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) ) & 386 & * fse3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj) 387 END IF 334 388 335 389 ze3t_f = 1.e0 / ze3t_f … … 340 394 ze3t_d = 1.e0 / ( ze3t_n + rbcp * ze3t_d ) 341 395 pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n + rbcp * ztc_d ) ! ta <-- Brown & Campana average 396 ENDIF 397 IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN 398 ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n 342 399 ENDIF 343 400 END DO … … 347 404 END DO 348 405 ! 406 IF( l_trdtra .and. cdtype == 'TRA' ) THEN 407 CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 408 CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 409 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 410 ENDIF 411 IF( l_trdtrc .and. cdtype == 'TRC' ) THEN 412 DO jn = 1, kjpt 413 CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 414 END DO 415 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 416 ENDIF 417 349 418 END SUBROUTINE tra_nxt_vvl 350 419 -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r7960 r9987 10 10 !! - ! 2005-11 (G. Madec) zco, zps, sco coordinate 11 11 !! 3.2 ! 2009-04 (G. Madec & NEMO team) 12 !! 4.0 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model 12 !! 3.4 ! 2012-05 (C. Rousset) store attenuation coef for use in ice model 13 !! 3.6 ! 2015-12 (O. Aumont, J. Jouanno, C. Ethe) use vertical profile of chlorophyll 13 14 !!---------------------------------------------------------------------- 14 15 … … 93 94 !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 94 95 !! Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 96 !! Morel, A. et Berthon, JF, 1989, Limnol Oceanogr 34(8), 1545-1562 95 97 !!---------------------------------------------------------------------- 96 98 ! … … 101 103 REAL(wp) :: zchl, zcoef, zfact ! local scalars 102 104 REAL(wp) :: zc0, zc1, zc2, zc3 ! - - 103 REAL(wp) :: zzc0, zzc1, zzc2, zzc3 ! - -104 105 REAL(wp) :: zz0, zz1, z1_e3t ! - - 106 REAL(wp) :: zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 107 REAL(wp) :: zlogc, zlogc2, zlogc3 105 108 REAL(wp), POINTER, DIMENSION(:,: ) :: zekb, zekg, zekr 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 107 !!---------------------------------------------------------------------- 109 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt, zchl3d 110 !!-------------------------------------------------------------------------- 108 111 ! 109 112 IF( nn_timing == 1 ) CALL timing_start('tra_qsr') 110 113 ! 111 114 CALL wrk_alloc( jpi, jpj, zekb, zekg, zekr ) 112 CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )115 CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 113 116 ! 114 117 IF( kt == nit000 ) THEN … … 183 186 ! ! ------------------------- ! 184 187 ! Set chlorophyl concentration 185 IF( nn_chldta == 1 .OR. lk_vvl ) THEN !* Variable Chlorophyll or ocean volume 186 ! 187 IF( nn_chldta == 1 ) THEN !* Variable Chlorophyll 188 ! 189 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 190 ! 191 !CDIR COLLAPSE 188 IF( nn_chldta == 1 .OR. nn_chldta == 2 .OR. lk_vvl ) THEN !* Variable Chlorophyll or ocean volume 189 ! 190 IF( nn_chldta == 1 ) THEN !* 2D Variable Chlorophyll 191 ! 192 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 193 DO jk = 1, nksr + 1 194 zchl3d(:,:,jk) = sf_chl(1)%fnow(:,:,1) 195 ENDDO 196 ! 197 ELSE IF( nn_chldta == 2 ) THEN !* -3-D Variable Chlorophyll 198 ! 199 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 200 !CDIR NOVERRCHK ! 201 DO jj = 1, jpj 192 202 !CDIR NOVERRCHK 193 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl 194 !CDIR NOVERRCHK 195 DO ji = 1, jpi 196 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 197 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 198 zekb(ji,jj) = rkrgb(1,irgb) 199 zekg(ji,jj) = rkrgb(2,irgb) 200 zekr(ji,jj) = rkrgb(3,irgb) 201 END DO 202 END DO 203 ELSE ! Variable ocean volume but constant chrlorophyll 204 zchl = 0.05 ! constant chlorophyll 205 irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 ) 206 zekb(:,:) = rkrgb(1,irgb) ! Separation in R-G-B depending of the chlorophyll 207 zekg(:,:) = rkrgb(2,irgb) 208 zekr(:,:) = rkrgb(3,irgb) 203 DO ji = 1, jpi 204 zchl = sf_chl(1)%fnow(ji,jj,1) 205 zCtot = 40.6 * zchl**0.459 206 zze = 568.2 * zCtot**(-0.746) 207 IF( zze > 102. ) zze = 200.0 * zCtot**(-0.293) 208 zlogc = LOG( zchl ) 209 zlogc2 = zlogc * zlogc 210 zlogc3 = zlogc * zlogc * zlogc 211 zCb = 0.768 + 0.087 * zlogc - 0.179 * zlogc2 - 0.025 * zlogc3 212 zCmax = 0.299 - 0.289 * zlogc + 0.579 * zlogc2 213 zpsimax = 0.6 - 0.640 * zlogc + 0.021 * zlogc2 + 0.115 * zlogc3 214 zdelpsi = 0.710 + 0.159 * zlogc + 0.021 * zlogc2 215 zCze = 1.12 * (zchl)**0.803 216 DO jk = 1, nksr + 1 217 zpsi = fsdept(ji,jj,jk) / zze 218 zchl3d(ji,jj,jk) = zCze * ( zCb + zCmax * EXP( -( (zpsi - zpsimax) / zdelpsi )**2 ) ) 219 END DO 220 ! 221 END DO 222 END DO 223 ! 224 ELSE !* Variable ocean volume but constant chrlorophyll 225 DO jk = 1, nksr + 1 226 zchl3d(:,:,jk) = 0.05 227 ENDDO 209 228 ENDIF 210 229 ! 211 zcoef = ( 1. - rn_abs ) / 3.e0 ! equi-partition in R-G-B230 zcoef = ( 1. - rn_abs ) / 3.e0 ! equi-partition in R-G-B 212 231 ze0(:,:,1) = rn_abs * qsr(:,:) 213 232 ze1(:,:,1) = zcoef * qsr(:,:) … … 217 236 ! 218 237 DO jk = 2, nksr+1 238 ! 239 DO jj = 1, jpj ! Separation in R-G-B depending of vertical profile of Chl 240 !CDIR NOVERRCHK 241 DO ji = 1, jpi 242 zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,jk) ) ) 243 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 244 zekb(ji,jj) = rkrgb(1,irgb) 245 zekg(ji,jj) = rkrgb(2,irgb) 246 zekr(ji,jj) = rkrgb(3,irgb) 247 END DO 248 END DO 219 249 !CDIR NOVERRCHK 220 250 DO jj = 1, jpj … … 233 263 END DO 234 264 END DO 235 ! clem: store attenuation coefficient of the first ocean level236 IF ( ln_qsr_ice ) THEN237 DO jj = 1, jpj238 DO ji = 1, jpi239 zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r )240 zzc1 = zcoef * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) )241 zzc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) )242 zzc3 = zcoef * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) )243 fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2 + zzc3 ) * tmask(ji,jj,2)244 END DO245 END DO246 ENDIF247 265 ! 248 266 DO jk = 1, nksr ! compute and add qsr trend to ta … … 251 269 zea(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero 252 270 CALL iom_put( 'qsr3d', zea ) ! Shortwave Radiation 3D distribution 271 ! 272 IF ( ln_qsr_ice ) THEN ! store attenuation coefficient of the first ocean level 273 !CDIR NOVERRCHK 274 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl 275 !CDIR NOVERRCHK 276 DO ji = 1, jpi 277 zchl = MIN( 10. , MAX( 0.03, zchl3d(ji,jj,1) ) ) 278 irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 279 zekb(ji,jj) = rkrgb(1,irgb) 280 zekg(ji,jj) = rkrgb(2,irgb) 281 zekr(ji,jj) = rkrgb(3,irgb) 282 END DO 283 END DO 284 ! 285 DO jj = 1, jpj 286 DO ji = 1, jpi 287 zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r ) 288 zc1 = zcoef * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 289 zc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 290 zc3 = zcoef * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 291 fraqsr_1lev(ji,jj) = 1.0 - ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,2) 292 END DO 293 END DO 294 ! 295 ENDIF 253 296 ! 254 297 ELSE !* Constant Chlorophyll … … 256 299 qsr_hc(:,:,jk) = etot3(:,:,jk) * qsr(:,:) 257 300 END DO 258 ! clem:store attenuation coefficient of the first ocean level259 IF 301 ! store attenuation coefficient of the first ocean level 302 IF( ln_qsr_ice ) THEN 260 303 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 261 304 ENDIF … … 339 382 ! 340 383 CALL wrk_dealloc( jpi, jpj, zekb, zekg, zekr ) 341 CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )384 CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 342 385 ! 343 386 IF( nn_timing == 1 ) CALL timing_stop('tra_qsr') … … 405 448 WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio 406 449 WRITE(numout,*) ' light penetration for ice-model LIM3 ln_qsr_ice = ', ln_qsr_ice 407 WRITE(numout,*) ' RGB : Chl data (=1 ) or cst value (=0)nn_chldta = ', nn_chldta450 WRITE(numout,*) ' RGB : Chl data (=1/2) or cst value (=0) nn_chldta = ', nn_chldta 408 451 WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs 409 452 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 … … 429 472 IF( ln_qsr_rgb .AND. nn_chldta == 0 ) nqsr = 1 430 473 IF( ln_qsr_rgb .AND. nn_chldta == 1 ) nqsr = 2 431 IF( ln_qsr_2bd ) nqsr = 3 432 IF( ln_qsr_bio ) nqsr = 4 474 IF( ln_qsr_rgb .AND. nn_chldta == 2 ) nqsr = 3 475 IF( ln_qsr_2bd ) nqsr = 4 476 IF( ln_qsr_bio ) nqsr = 5 433 477 ! 434 478 IF(lwp) THEN ! Print the choice 435 479 WRITE(numout,*) 436 480 IF( nqsr == 1 ) WRITE(numout,*) ' R-G-B light penetration - Constant Chlorophyll' 437 IF( nqsr == 2 ) WRITE(numout,*) ' R-G-B light penetration - Chl data ' 438 IF( nqsr == 3 ) WRITE(numout,*) ' 2 bands light penetration' 439 IF( nqsr == 4 ) WRITE(numout,*) ' bio-model light penetration' 481 IF( nqsr == 2 ) WRITE(numout,*) ' R-G-B light penetration - 2D Chl data ' 482 IF( nqsr == 3 ) WRITE(numout,*) ' R-G-B light penetration - 3D Chl data ' 483 IF( nqsr == 4 ) WRITE(numout,*) ' 2 bands light penetration' 484 IF( nqsr == 5 ) WRITE(numout,*) ' bio-model light penetration' 440 485 ENDIF 441 486 ! … … 460 505 IF(lwp) WRITE(numout,*) ' level of light extinction = ', nksr, ' ref depth = ', gdepw_1d(nksr+1), ' m' 461 506 ! 462 IF( nn_chldta == 1 ) THEN !* Chl data : set sf_chl structure507 IF( nn_chldta == 1 .OR. nn_chldta == 2 ) THEN !* Chl data : set sf_chl structure 463 508 IF(lwp) WRITE(numout,*) 464 509 IF(lwp) WRITE(numout,*) ' Chlorophyll read in a file' -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7960 r9987 33 33 USE timing ! Timing 34 34 USE eosbn2 35 #if defined key_asminc 36 USE asminc ! Assimilation increment 37 #endif 35 38 36 39 IMPLICIT NONE … … 159 162 ELSE ! No restart or restart not found: Euler forward time stepping 160 163 zfact = 1._wp 164 sbc_tsc(:,:,:) = 0._wp 161 165 sbc_tsc_b(:,:,:) = 0._wp 162 166 ENDIF … … 232 236 DO jk = ikt, ikb - 1 233 237 ! compute tfreez for the temperature correction (we add water at freezing temperature) 234 ! zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04235 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress )236 238 ! compute trend 237 239 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 238 & + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) & 239 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 240 & * r1_hisf_tbl(ji,jj) 240 & + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj) 241 241 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 242 242 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) … … 245 245 ! level partially include in ice shelf boundary layer 246 246 ! compute tfreez for the temperature correction (we add water at freezing temperature) 247 ! zpress = grav*rau0*fsdept(ji,jj,ikb)*1.e-04248 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,ikb,jp_sal), zpress )249 247 ! compute trend 250 248 tsa(ji,jj,ikb,jp_tem) = tsa(ji,jj,ikb,jp_tem) & 251 & + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem) & 252 & - rdivisf * (fwfisf(ji,jj) + fwfisf_b(ji,jj)) * zt_frz * r1_rau0) & 253 & * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 249 & + zfact * (risf_tsc_b(ji,jj,jp_tem) + risf_tsc(ji,jj,jp_tem)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) 254 250 tsa(ji,jj,ikb,jp_sal) = tsa(ji,jj,ikb,jp_sal) & 255 251 & + zfact * (risf_tsc_b(ji,jj,jp_sal) + risf_tsc(ji,jj,jp_sal)) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) … … 287 283 END DO 288 284 ENDIF 285 286 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*tsn(:,:,1,jp_tem) ) ! runoff term on sst 287 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) ) ! runoff term on sss 288 289 #if defined key_asminc 290 ! WARNING: THIS MAY WELL NOT BE REQUIRED - WE DON'T WANT TO CHANGE T&S BUT THIS MAY COMPENSATE ANOTHER TERM... 291 ! Rate of change in e3t for each level is ssh_iau*e3t_0/ht_0 292 ! Contribution to tsa should be rate of change in level / per m of ocean? (hence the division by fse3t_n) 293 IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation 294 DO jj = 2, jpj 295 DO ji = fs_2, fs_jpim1 296 zdep = ssh_iau(ji,jj) / ( ht_0(ji,jj) + 1.0 - ssmask(ji, jj) ) 297 DO jk = 1, jpkm1 298 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 299 & + tsn(ji,jj,jk,jp_tem) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 300 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 301 & + tsn(ji,jj,jk,jp_sal) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 302 END DO 303 END DO 304 END DO 305 ENDIF 306 #endif 289 307 290 308 IF( l_trdtra ) THEN ! send trends for further diagnostics -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r7960 r9987 94 94 95 95 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 96 DO jk = 1, jpkm1 97 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 98 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 99 END DO 96 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn. 97 IF( lk_vvl ) THEN 98 DO jk = 1, jpkm1 99 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) - tsb(:,:,jk,jp_tem)*fse3t_b(:,:,jk) ) & 100 & / (fse3t_n(:,:,jk)*r2dtra(jk)) ) - ztrdt(:,:,jk) 101 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) - tsb(:,:,jk,jp_sal)*fse3t_b(:,:,jk) ) & 102 & / (fse3t_n(:,:,jk)*r2dtra(jk)) ) - ztrds(:,:,jk) 103 END DO 104 ELSE 105 DO jk = 1, jpkm1 106 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 107 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 108 END DO 109 END IF 100 110 CALL lbc_lnk( ztrdt, 'T', 1. ) 101 111 CALL lbc_lnk( ztrds, 'T', 1. )
Note: See TracChangeset
for help on using the changeset viewer.
