Changeset 13710 for NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diawri.F90
- Timestamp:
- 2020-11-02T10:56:42+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DIA/diawri.F90 (modified) (31 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- 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 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diawri.F90
r12649 r13710 85 85 !! * Substitutions 86 86 # include "do_loop_substitute.h90" 87 # include "domzgr_substitute.h90" 87 88 !!---------------------------------------------------------------------- 88 89 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 117 118 INTEGER :: ji, jj, jk ! dummy loop indices 118 119 INTEGER :: ikbot ! local integer 120 REAL(wp):: ze3 119 121 REAL(wp):: zztmp , zztmpx ! local scalar 120 122 REAL(wp):: zztmp2, zztmpy ! - - … … 136 138 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 137 139 ! 138 CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 139 CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 140 CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 141 CALL iom_put( "e3w" , e3w(:,:,:,Kmm) ) 142 IF( iom_use("e3tdef") ) & 143 CALL iom_put( "e3tdef" , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 144 145 IF( ll_wd ) THEN 146 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying) 140 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t 141 DO jk = 1, jpk 142 z3d(:,:,jk) = e3t(:,:,jk,Kmm) 143 END DO 144 CALL iom_put( "e3t" , z3d(:,:,:) ) 145 CALL iom_put( "e3tdef" , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 146 ENDIF 147 IF ( iom_use("e3u") ) THEN ! time-varying e3u 148 DO jk = 1, jpk 149 z3d(:,:,jk) = e3u(:,:,jk,Kmm) 150 END DO 151 CALL iom_put( "e3u" , z3d(:,:,:) ) 152 ENDIF 153 IF ( iom_use("e3v") ) THEN ! time-varying e3v 154 DO jk = 1, jpk 155 z3d(:,:,jk) = e3v(:,:,jk,Kmm) 156 END DO 157 CALL iom_put( "e3v" , z3d(:,:,:) ) 158 ENDIF 159 IF ( iom_use("e3w") ) THEN ! time-varying e3w 160 DO jk = 1, jpk 161 z3d(:,:,jk) = e3w(:,:,jk,Kmm) 162 END DO 163 CALL iom_put( "e3w" , z3d(:,:,:) ) 164 ENDIF 165 166 IF( ll_wd ) THEN ! sea surface height (brought back to the reference used for wetting and drying) 167 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 147 168 ELSE 148 169 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height … … 155 176 CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 156 177 IF ( iom_use("sbt") ) THEN 157 DO_2D _11_11178 DO_2D( 0, 0, 0, 0 ) 158 179 ikbot = mbkt(ji,jj) 159 180 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) … … 165 186 CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity 166 187 IF ( iom_use("sbs") ) THEN 167 DO_2D _11_11188 DO_2D( 0, 0, 0, 0 ) 168 189 ikbot = mbkt(ji,jj) 169 190 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) … … 172 193 ENDIF 173 194 195 #if ! defined key_qco 196 CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0) 197 #endif 198 174 199 IF ( iom_use("taubot") ) THEN ! bottom stress 175 200 zztmp = rho0 * 0.25 176 201 z2d(:,:) = 0._wp 177 DO_2D _00_00202 DO_2D( 0, 0, 0, 0 ) 178 203 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 179 204 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & … … 183 208 ! 184 209 END_2D 185 CALL lbc_lnk( 'diawri', z2d, 'T', 1. )186 210 CALL iom_put( "taubot", z2d ) 187 211 ENDIF … … 190 214 CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current 191 215 IF ( iom_use("sbu") ) THEN 192 DO_2D _11_11216 DO_2D( 0, 0, 0, 0 ) 193 217 ikbot = mbku(ji,jj) 194 218 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) … … 200 224 CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current 201 225 IF ( iom_use("sbv") ) THEN 202 DO_2D _11_11226 DO_2D( 0, 0, 0, 0 ) 203 227 ikbot = mbkv(ji,jj) 204 228 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) … … 208 232 209 233 IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 210 !211 234 CALL iom_put( "woce", ww ) ! vertical velocity 235 212 236 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 213 237 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. … … 229 253 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 230 254 255 IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN 256 z3d(:,:,jpk) = 0. 257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 258 zztmp = ts(ji,jj,jk,jp_sal,Kmm) 259 zztmpx = (ts(ji+1,jj,jk,jp_sal,Kmm) - zztmp) * r1_e1u(ji,jj) + (zztmp - ts(ji-1,jj ,jk,jp_sal,Kmm)) * r1_e1u(ji-1,jj) 260 zztmpy = (ts(ji,jj+1,jk,jp_sal,Kmm) - zztmp) * r1_e2v(ji,jj) + (zztmp - ts(ji ,jj-1,jk,jp_sal,Kmm)) * r1_e2v(ji,jj-1) 261 z3d(ji,jj,jk) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 262 & * umask(ji,jj,jk) * umask(ji-1,jj,jk) * vmask(ji,jj,jk) * umask(ji,jj-1,jk) 263 END_3D 264 CALL iom_put( "socegrad2", z3d ) ! square of module of sal gradient 265 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 266 z3d(ji,jj,jk) = SQRT( z3d(ji,jj,jk) ) 267 END_3D 268 CALL iom_put( "socegrad" , z3d ) ! module of sal gradient 269 ENDIF 270 231 271 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 232 DO_2D _00_00272 DO_2D( 0, 0, 0, 0 ) ! sst gradient 233 273 zztmp = ts(ji,jj,1,jp_tem,Kmm) 234 274 zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) … … 237 277 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 238 278 END_2D 239 CALL lbc_lnk( 'diawri', z2d, 'T', 1. )240 279 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 241 z2d(:,:) = SQRT( z2d(:,:) ) 280 DO_2D( 0, 0, 0, 0 ) 281 z2d(ji,jj) = SQRT( z2d(ji,jj) ) 282 END_2D 242 283 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 243 284 ENDIF … … 246 287 IF( iom_use("heatc") ) THEN 247 288 z2d(:,:) = 0._wp 248 DO_3D _11_11(1, jpkm1 )289 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 249 290 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 250 291 END_3D … … 254 295 IF( iom_use("saltc") ) THEN 255 296 z2d(:,:) = 0._wp 256 DO_3D _11_11(1, jpkm1 )297 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 257 298 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 258 299 END_3D … … 260 301 ENDIF 261 302 ! 262 IF ( iom_use("eken") ) THEN 303 IF( iom_use("salt2c") ) THEN 304 z2d(:,:) = 0._wp 305 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 306 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 307 END_3D 308 CALL iom_put( "salt2c", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 309 ENDIF 310 ! 311 IF ( iom_use("ke") .OR. iom_use("ke_int") ) THEN 263 312 z3d(:,:,jpk) = 0._wp 264 DO_3D_00_00( 1, jpkm1 ) 265 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 266 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 267 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 268 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 269 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 270 END_3D 271 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 272 CALL iom_put( "eken", z3d ) ! kinetic energy 313 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 314 zztmpx = 0.5 * ( uu(ji-1,jj ,jk,Kmm) + uu(ji,jj,jk,Kmm) ) 315 zztmpy = 0.5 * ( vv(ji ,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm) ) 316 z3d(ji,jj,jk) = 0.5 * ( zztmpx*zztmpx + zztmpy*zztmpy ) 317 END_3D 318 CALL iom_put( "ke", z3d ) ! kinetic energy 319 320 z2d(:,:) = 0._wp 321 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 322 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk) 323 END_3D 324 CALL iom_put( "ke_int", z2d ) ! vertically integrated kinetic energy 273 325 ENDIF 274 326 ! 275 327 CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence 328 329 IF ( iom_use("relvor") .OR. iom_use("absvor") .OR. iom_use("potvor") ) THEN 330 331 z3d(:,:,jpk) = 0._wp 332 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 333 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm) & 334 & - e1u(ji ,jj+1) * uu(ji ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm) ) * r1_e1e2f(ji,jj) 335 END_3D 336 CALL iom_put( "relvor", z3d ) ! relative vorticity 337 338 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 339 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 340 END_3D 341 CALL iom_put( "absvor", z3d ) ! absolute vorticity 342 343 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 344 ze3 = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 345 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 346 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 347 ELSE ; ze3 = 0._wp 348 ENDIF 349 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 350 END_3D 351 CALL iom_put( "potvor", z3d ) ! potential vorticity 352 353 ENDIF 276 354 ! 277 355 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN … … 288 366 IF( iom_use("u_heattr") ) THEN 289 367 z2d(:,:) = 0._wp 290 DO_3D _00_00(1, jpkm1 )368 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 291 369 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 292 370 END_3D 293 CALL lbc_lnk( 'diawri', z2d, 'U', -1. )294 371 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 295 372 ENDIF … … 297 374 IF( iom_use("u_salttr") ) THEN 298 375 z2d(:,:) = 0.e0 299 DO_3D _00_00(1, jpkm1 )376 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 300 377 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 301 378 END_3D 302 CALL lbc_lnk( 'diawri', z2d, 'U', -1. )303 379 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 304 380 ENDIF … … 315 391 IF( iom_use("v_heattr") ) THEN 316 392 z2d(:,:) = 0.e0 317 DO_3D _00_00(1, jpkm1 )393 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 318 394 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 319 395 END_3D 320 CALL lbc_lnk( 'diawri', z2d, 'V', -1. )321 396 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 322 397 ENDIF … … 324 399 IF( iom_use("v_salttr") ) THEN 325 400 z2d(:,:) = 0._wp 326 DO_3D _00_00(1, jpkm1 )401 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 327 402 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 328 403 END_3D 329 CALL lbc_lnk( 'diawri', z2d, 'V', -1. )330 404 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 331 405 ENDIF … … 333 407 IF( iom_use("tosmint") ) THEN 334 408 z2d(:,:) = 0._wp 335 DO_3D _00_00(1, jpkm1 )409 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 336 410 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 337 411 END_3D 338 CALL lbc_lnk( 'diawri', z2d, 'T', -1. )339 412 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature 340 413 ENDIF 341 414 IF( iom_use("somint") ) THEN 342 415 z2d(:,:)=0._wp 343 DO_3D _00_00(1, jpkm1 )416 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 344 417 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 345 418 END_3D 346 CALL lbc_lnk( 'diawri', z2d, 'T', -1. )347 419 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity 348 420 ENDIF … … 415 487 ! 416 488 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 417 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace489 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t, zgdept ! 3D workspace 418 490 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 419 491 !!---------------------------------------------------------------------- … … 447 519 448 520 ! Define indices of the horizontal output zoom and vertical limit storage 449 iimi = 1 ; iima = jpi450 ijmi = 1 ; ijma = jpj521 iimi = Nis0 ; iima = Nie0 522 ijmi = Njs0 ; ijma = Nje0 451 523 ipk = jpk 452 524 IF(ln_abl) ipka = jpkam1 … … 455 527 it = kt 456 528 itmod = kt - nit000 + 1 529 530 ! store e3t for subsitute 531 DO jk = 1, jpk 532 ze3t (:,:,jk) = e3t (:,:,jk,Kmm) 533 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 534 END DO 457 535 458 536 … … 569 647 DEALLOCATE(zw3d_abl) 570 648 ENDIF 649 ! 571 650 572 651 ! Declare all the output fields as NETCDF variables … … 578 657 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 579 658 IF( .NOT.ln_linssh ) THEN 580 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t (:,:,:,Kmm)659 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t n 581 660 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 582 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t (:,:,:,Kmm)661 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t n 583 662 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 584 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t (:,:,:,Kmm)663 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t n 585 664 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 586 665 ENDIF … … 766 845 767 846 IF( .NOT.ln_linssh ) THEN 768 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! heat content769 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! salt content770 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface heat content771 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface salinity content847 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! heat content 848 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! salt content 849 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content 850 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content 772 851 ELSE 773 852 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T ) ! temperature … … 777 856 ENDIF 778 857 IF( .NOT.ln_linssh ) THEN 779 zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2780 CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm), ndim_T , ndex_T ) ! level thickness781 CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T ) ! t-point depth858 zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 859 CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:) , ndim_T , ndex_T ) ! level thickness 860 CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T ) ! t-point depth 782 861 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 783 862 ENDIF … … 918 997 !! 919 998 INTEGER :: inum, jk 999 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace !!st patch to use substitution 920 1000 !!---------------------------------------------------------------------- 921 1001 ! 922 IF(lwp) WRITE(numout,*) 923 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 924 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 925 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 1002 IF(lwp) THEN 1003 WRITE(numout,*) 1004 WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 1005 WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 1006 WRITE(numout,*) ' and named :', cdfile_name, '...nc' 1007 ENDIF 1008 ! 1009 DO jk = 1, jpk 1010 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 1011 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 1012 END DO 926 1013 ! 927 1014 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) … … 938 1025 ENDIF 939 1026 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 940 CALL iom_rstput( 0, 0, inum, 'ht' , ht 1027 CALL iom_rstput( 0, 0, inum, 'ht' , ht(:,:) ) ! now water column height 941 1028 ! 942 1029 IF ( ln_isf ) THEN … … 975 1062 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 976 1063 IF( .NOT.ln_linssh ) THEN 977 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)) ! T-cell depth978 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)) ! T-cell thickness1064 CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept ) ! T-cell depth 1065 CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t ) ! T-cell thickness 979 1066 END IF 980 1067 IF( ln_wave .AND. ln_sdw ) THEN … … 998 1085 CALL iom_close( inum ) 999 1086 ENDIF 1087 ! 1000 1088 #endif 1001 1002 1089 END SUBROUTINE dia_wri_state 1003 1090
Note: See TracChangeset
for help on using the changeset viewer.
