Changeset 14062 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DIA/diawri.F90
- Timestamp:
- 2020-12-03T17:39:30+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DIA/diawri.F90
r14037 r14062 19 19 !! 3.7 ! 2014-01 (G. Madec) remove eddy induced velocity from no-IOM output 20 20 !! ! change name of output variables in dia_wri_state 21 !! 4.0 ! 2020-10 (A. Nasser, S. Techene) add diagnostic for SWE 21 22 !!---------------------------------------------------------------------- 22 23 … … 46 47 USE zdfdrg ! ocean vertical physics: top/bottom friction 47 48 USE zdfmxl ! mixed layer 49 USE zdfosm ! mixed layer 48 50 ! 49 51 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 118 120 INTEGER :: ji, jj, jk ! dummy loop indices 119 121 INTEGER :: ikbot ! local integer 120 REAL(wp):: ze3121 122 REAL(wp):: zztmp , zztmpx ! local scalar 122 123 REAL(wp):: zztmp2, zztmpy ! - - 124 REAL(wp):: ze3 123 125 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 124 126 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace … … 137 139 CALL iom_put("e3u_0", e3u_0(:,:,:) ) 138 140 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 141 CALL iom_put("e3f_0", e3f_0(:,:,:) ) 139 142 ! 140 143 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t … … 163 166 CALL iom_put( "e3w" , z3d(:,:,:) ) 164 167 ENDIF 168 IF ( iom_use("e3f") ) THEN ! time-varying e3f caution here at Kaa 169 DO jk = 1, jpk 170 z3d(:,:,jk) = e3f(:,:,jk) 171 END DO 172 CALL iom_put( "e3f" , z3d(:,:,:) ) 173 ENDIF 165 174 166 175 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) )176 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*ssmask(:,:) ) 168 177 ELSE 169 178 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height 170 179 ENDIF 171 180 172 IF( iom_use("wetdep") ) & ! wet depth 173 CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) 181 IF( iom_use("wetdep") ) CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) ! wet depth 182 183 #if defined key_qco 184 IF( iom_use("ht") ) CALL iom_put( "ht" , ht(:,:) ) ! water column at t-point 185 IF( iom_use("hu") ) CALL iom_put( "hu" , hu(:,:,Kmm) ) ! water column at u-point 186 IF( iom_use("hv") ) CALL iom_put( "hv" , hv(:,:,Kmm) ) ! water column at v-point 187 IF( iom_use("hf") ) CALL iom_put( "hf" , hf_0(:,:)*( 1._wp + r3f(:,:) ) ) ! water column at f-point (caution here at Naa) 188 #endif 174 189 175 190 CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature … … 325 340 ENDIF 326 341 ! 342 IF ( iom_use("sKE") ) THEN ! surface kinetic energy at T point 343 z2d(:,:) = 0._wp 344 DO_2D( 0, 0, 0, 0 ) 345 z2d(ji,jj) = 0.25_wp * ( uu(ji ,jj,1,Kmm) * uu(ji ,jj,1,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,1,Kmm) & 346 & + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm) & 347 & + vv(ji,jj ,1,Kmm) * vv(ji,jj ,1,Kmm) * e1e2v(ji,jj ) * e3v(ji,jj ,1,Kmm) & 348 & + vv(ji,jj-1,1,Kmm) * vv(ji,jj-1,1,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,1,Kmm) ) & 349 & * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * ssmask(ji,jj) 350 END_2D 351 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 352 IF ( iom_use("sKE" ) ) CALL iom_put( "sKE" , z2d ) 353 ENDIF 354 ! 355 IF ( iom_use("sKEf") ) THEN ! surface kinetic energy at F point 356 z2d(:,:) = 0._wp ! CAUTION : only valid in SWE, not with bathymetry 357 DO_2D( 0, 0, 0, 0 ) 358 z2d(ji,jj) = 0.25_wp * ( uu(ji,jj ,1,Kmm) * uu(ji,jj ,1,Kmm) * e1e2u(ji,jj ) * e3u(ji,jj ,1,Kmm) & 359 & + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm) & 360 & + vv(ji ,jj,1,Kmm) * vv(ji,jj ,1,Kmm) * e1e2v(ji ,jj) * e3v(ji ,jj,1,Kmm) & 361 & + vv(ji+1,jj,1,Kmm) * vv(ji+1,jj,1,Kmm) * e1e2v(ji+1,jj) * e3v(ji+1,jj,1,Kmm) ) & 362 & * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj) 363 END_2D 364 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 365 CALL iom_put( "sKEf", z2d ) 366 ENDIF 367 ! 327 368 CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence 328 369 … … 424 465 425 466 IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging 467 468 ! Output of vorticity terms 469 IF ( iom_use("relvor") .OR. iom_use("plavor") .OR. & 470 & iom_use("relpotvor") .OR. iom_use("abspotvor") .OR. & 471 & iom_use("Ens") ) THEN 472 ! 473 z2d(:,:) = 0._wp 474 ze3 = 0._wp 475 DO_2D( 1, 0, 1, 0 ) 476 z2d(ji,jj) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm) & 477 & - e1u(ji ,jj+1) * uu(ji ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm) ) * r1_e1e2f(ji,jj) 478 END_2D 479 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 480 CALL iom_put( "relvor", z2d ) ! relative vorticity ( zeta ) 481 ! 482 CALL iom_put( "plavor", ff_f ) ! planetary vorticity ( f ) 483 ! 484 DO_2D( 1, 0, 1, 0 ) 485 ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 486 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) 487 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 488 ELSE ; ze3 = 0._wp 489 ENDIF 490 z2d(ji,jj) = ze3 * z2d(ji,jj) 491 END_2D 492 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 493 CALL iom_put( "relpotvor", z2d ) ! relative potential vorticity (zeta/h) 494 ! 495 DO_2D( 1, 0, 1, 0 ) 496 ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 497 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) 498 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 499 ELSE ; ze3 = 0._wp 500 ENDIF 501 z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj) 502 END_2D 503 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 504 CALL iom_put( "abspotvor", z2d ) ! absolute potential vorticity ( q ) 505 ! 506 DO_2D( 1, 0, 1, 0 ) 507 z2d(ji,jj) = 0.5_wp * z2d(ji,jj) * z2d(ji,jj) 508 END_2D 509 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 510 CALL iom_put( "Ens", z2d ) ! potential enstrophy ( 1/2*q2 ) 511 ! 512 ENDIF 426 513 427 514 IF( ln_timing ) CALL timing_stop('dia_wri') … … 997 1084 !! 998 1085 INTEGER :: inum, jk 999 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace !!st patch to usesubstitution1086 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace for qco substitution 1000 1087 !!---------------------------------------------------------------------- 1001 1088 ! … … 1076 1163 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 1077 1164 ENDIF 1165 IF( ln_zdfosm ) THEN 1166 CALL iom_rstput( 0, 0, inum, 'hbl', hbl*tmask(:,:,1) ) ! now boundary-layer depth 1167 CALL iom_rstput( 0, 0, inum, 'hml', hml*tmask(:,:,1) ) ! now mixed-layer depth 1168 CALL iom_rstput( 0, 0, inum, 'avt_k', avt_k*wmask ) ! w-level diffusion 1169 CALL iom_rstput( 0, 0, inum, 'avm_k', avm_k*wmask ) ! now w-level viscosity 1170 CALL iom_rstput( 0, 0, inum, 'ghamt', ghamt*wmask ) ! non-local t forcing 1171 CALL iom_rstput( 0, 0, inum, 'ghams', ghams*wmask ) ! non-local s forcing 1172 CALL iom_rstput( 0, 0, inum, 'ghamu', ghamu*umask ) ! non-local u forcing 1173 CALL iom_rstput( 0, 0, inum, 'ghamv', ghamv*vmask ) ! non-local v forcing 1174 IF( ln_osm_mle ) THEN 1175 CALL iom_rstput( 0, 0, inum, 'hmle', hmle*tmask(:,:,1) ) ! now transition-layer depth 1176 END IF 1177 ENDIF 1078 1178 ! 1079 1179 CALL iom_close( inum )
Note: See TracChangeset
for help on using the changeset viewer.
