Changeset 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/tests/CANAL/MY_SRC/diawri.F90
- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
tests/CANAL/MY_SRC/diawri.F90 (modified) (48 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/tests/CANAL/MY_SRC/diawri.F90
r12178 r12928 26 26 !!---------------------------------------------------------------------- 27 27 USE oce ! ocean dynamics and tracers 28 USE isf_oce 29 USE isfcpl 30 USE abl ! abl variables in case ln_abl = .true. 28 31 USE dom_oce ! ocean space and time domain 29 32 USE phycst ! physical constants … … 46 49 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 47 50 USE in_out_manager ! I/O manager 48 USE diatmb ! Top,middle,bottom output49 51 USE dia25h ! 25h Mean output 50 52 USE iom ! … … 57 59 USE lib_mpp ! MPP library 58 60 USE timing ! preformance summary 59 USE diu rnal_bulk! diurnal warm layer60 USE cool_skin! Cool skin61 USE diu_bulk ! diurnal warm layer 62 USE diu_coolskin ! Cool skin 61 63 62 64 IMPLICIT NONE … … 66 68 PUBLIC dia_wri_state 67 69 PUBLIC dia_wri_alloc ! Called by nemogcm module 68 70 #if ! defined key_iomput 71 PUBLIC dia_wri_alloc_abl ! Called by sbcabl module (if ln_abl = .true.) 72 #endif 69 73 INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file 70 74 INTEGER :: nb_T , ndim_bT ! grid_T file … … 72 76 INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file 73 77 INTEGER :: nid_W, nz_W, nh_W ! grid_W file 78 INTEGER :: nid_A, nz_A, nh_A, ndim_A, ndim_hA ! grid_ABL file 74 79 INTEGER :: ndex(1) ! ??? 75 80 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 81 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 76 82 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 77 83 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 78 84 79 85 !! * Substitutions 80 # include " vectopt_loop_substitute.h90"86 # include "do_loop_substitute.h90" 81 87 !!---------------------------------------------------------------------- 82 88 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 97 103 98 104 99 SUBROUTINE dia_wri( kt )105 SUBROUTINE dia_wri( kt, Kmm ) 100 106 !!--------------------------------------------------------------------- 101 107 !! *** ROUTINE dia_wri *** … … 107 113 !!---------------------------------------------------------------------- 108 114 INTEGER, INTENT( in ) :: kt ! ocean time-step index 115 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 109 116 !! 110 117 INTEGER :: ji, jj, jk ! dummy loop indices … … 115 122 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 116 123 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 117 REAL(wp), DIMENSION(jpi,jpj,jpk) :: bu, bv ! volume of u- and v-boxes118 REAL(wp), DIMENSION(jpi,jpj,jpk) :: r1_bt ! inverse of t-box volume119 124 !!---------------------------------------------------------------------- 120 125 ! … … 123 128 ! Output the initial state and forcings 124 129 IF( ninist == 1 ) THEN 125 CALL dia_wri_state( 'output.init' )130 CALL dia_wri_state( Kmm, 'output.init' ) 126 131 ninist = 0 127 132 ENDIF … … 132 137 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 133 138 ! 134 CALL iom_put( "e3t" , e3t _n(:,:,:) )135 CALL iom_put( "e3u" , e3u _n(:,:,:) )136 CALL iom_put( "e3v" , e3v _n(:,:,:) )137 CALL iom_put( "e3w" , e3w _n(:,:,:) )139 CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 140 CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 141 CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 142 CALL iom_put( "e3w" , e3w(:,:,:,Kmm) ) 138 143 IF( iom_use("e3tdef") ) & 139 CALL iom_put( "e3tdef" , ( ( e3t _n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 )144 CALL iom_put( "e3tdef" , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 140 145 141 146 IF( ll_wd ) THEN 142 CALL iom_put( "ssh" , (ssh n+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying)147 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying) 143 148 ELSE 144 CALL iom_put( "ssh" , ssh n) ! sea surface height149 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height 145 150 ENDIF 146 151 147 152 IF( iom_use("wetdep") ) & ! wet depth 148 CALL iom_put( "wetdep" , ht_0(:,:) + ssh n(:,:) )153 CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) 149 154 150 CALL iom_put( "toce", ts n(:,:,:,jp_tem) ) ! 3D temperature151 CALL iom_put( "sst", ts n(:,:,1,jp_tem) ) ! surface temperature155 CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature 156 CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 152 157 IF ( iom_use("sbt") ) THEN 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 ikbot = mbkt(ji,jj) 156 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_tem) 157 END DO 158 END DO 158 DO_2D_11_11 159 ikbot = mbkt(ji,jj) 160 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 161 END_2D 159 162 CALL iom_put( "sbt", z2d ) ! bottom temperature 160 163 ENDIF 161 164 162 CALL iom_put( "soce", ts n(:,:,:,jp_sal) ) ! 3D salinity163 CALL iom_put( "sss", ts n(:,:,1,jp_sal) ) ! surface salinity165 CALL iom_put( "soce", ts(:,:,:,jp_sal,Kmm) ) ! 3D salinity 166 CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity 164 167 IF ( iom_use("sbs") ) THEN 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 ikbot = mbkt(ji,jj) 168 z2d(ji,jj) = tsn(ji,jj,ikbot,jp_sal) 169 END DO 170 END DO 168 DO_2D_11_11 169 ikbot = mbkt(ji,jj) 170 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 171 END_2D 171 172 CALL iom_put( "sbs", z2d ) ! bottom salinity 172 173 ENDIF 173 174 174 175 IF ( iom_use("taubot") ) THEN ! bottom stress 175 zztmp = r au0 * 0.25176 zztmp = rho0 * 0.25 176 177 z2d(:,:) = 0._wp 177 DO jj = 2, jpjm1 178 DO ji = fs_2, fs_jpim1 ! vector opt. 179 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * un(ji ,jj,mbku(ji ,jj)) )**2 & 180 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * un(ji-1,jj,mbku(ji-1,jj)) )**2 & 181 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vn(ji,jj ,mbkv(ji,jj )) )**2 & 182 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vn(ji,jj-1,mbkv(ji,jj-1)) )**2 183 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 184 ! 185 END DO 186 END DO 178 DO_2D_00_00 179 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 180 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & 181 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vv(ji,jj ,mbkv(ji,jj ),Kmm) )**2 & 182 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm) )**2 183 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 184 ! 185 END_2D 187 186 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 188 187 CALL iom_put( "taubot", z2d ) 189 188 ENDIF 190 189 191 CALL iom_put( "uoce", u n(:,:,:) ) ! 3D i-current192 CALL iom_put( "ssu", u n(:,:,1) ) ! surface i-current190 CALL iom_put( "uoce", uu(:,:,:,Kmm) ) ! 3D i-current 191 CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current 193 192 IF ( iom_use("sbu") ) THEN 194 DO jj = 1, jpj 195 DO ji = 1, jpi 196 ikbot = mbku(ji,jj) 197 z2d(ji,jj) = un(ji,jj,ikbot) 198 END DO 199 END DO 193 DO_2D_11_11 194 ikbot = mbku(ji,jj) 195 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 196 END_2D 200 197 CALL iom_put( "sbu", z2d ) ! bottom i-current 201 198 ENDIF 202 199 203 CALL iom_put( "voce", v n(:,:,:) ) ! 3D j-current204 CALL iom_put( "ssv", v n(:,:,1) ) ! surface j-current200 CALL iom_put( "voce", vv(:,:,:,Kmm) ) ! 3D j-current 201 CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current 205 202 IF ( iom_use("sbv") ) THEN 206 DO jj = 1, jpj 207 DO ji = 1, jpi 208 ikbot = mbkv(ji,jj) 209 z2d(ji,jj) = vn(ji,jj,ikbot) 210 END DO 211 END DO 203 DO_2D_11_11 204 ikbot = mbkv(ji,jj) 205 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 206 END_2D 212 207 CALL iom_put( "sbv", z2d ) ! bottom j-current 213 208 ENDIF 214 209 215 CALL iom_put( "woce", wn ) ! vertical velocity 210 IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 211 ! 212 CALL iom_put( "woce", ww ) ! vertical velocity 216 213 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 217 214 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 218 z2d(:,:) = r au0 * e1e2t(:,:)215 z2d(:,:) = rho0 * e1e2t(:,:) 219 216 DO jk = 1, jpk 220 z3d(:,:,jk) = w n(:,:,jk) * z2d(:,:)217 z3d(:,:,jk) = ww(:,:,jk) * z2d(:,:) 221 218 END DO 222 219 CALL iom_put( "w_masstr" , z3d ) 223 220 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 224 221 ENDIF 222 ! 223 IF( ln_zad_Aimp ) ww = ww - wi ! Remove implicit part of vertical velocity that was added for diagnostic output 225 224 226 225 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. … … 231 230 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 232 231 233 IF ( iom_use("salgrad") .OR. iom_use("salgrad2") ) THEN234 z3d(:,:,jpk) = 0.235 DO jk = 1, jpkm1236 DO jj = 2, jpjm1 ! sal gradient237 DO ji = fs_2, fs_jpim1 ! vector opt.238 zztmp = tsn(ji,jj,jk,jp_sal)239 zztmpx = ( tsn(ji+1,jj,jk,jp_sal) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,jk,jp_sal) ) * r1_e1u(ji-1,jj)240 zztmpy = ( tsn(ji,jj+1,jk,jp_sal) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,jk,jp_sal) ) * r1_e2v(ji,jj-1)241 z3d(ji,jj,jk) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) &242 & * umask(ji,jj,jk) * umask(ji-1,jj,jk) * vmask(ji,jj,jk) * umask(ji,jj-1,jk)243 END DO244 END DO245 END DO246 CALL lbc_lnk( 'diawri', z3d, 'T', 1. )247 CALL iom_put( "salgrad2", z3d ) ! square of module of sal gradient248 z3d(:,:,:) = SQRT( z3d(:,:,:) )249 CALL iom_put( "salgrad" , z3d ) ! module of sal gradient250 ENDIF251 252 232 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 253 DO jj = 2, jpjm1 ! sst gradient 254 DO ji = fs_2, fs_jpim1 ! vector opt. 255 zztmp = tsn(ji,jj,1,jp_tem) 256 zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) * r1_e1u(ji-1,jj) 257 zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1) 258 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 259 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 260 END DO 261 END DO 233 DO_2D_00_00 234 zztmp = ts(ji,jj,1,jp_tem,Kmm) 235 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) 236 zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1) 237 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 238 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 239 END_2D 262 240 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 263 241 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient … … 269 247 IF( iom_use("heatc") ) THEN 270 248 z2d(:,:) = 0._wp 271 DO jk = 1, jpkm1 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 275 END DO 276 END DO 277 END DO 278 CALL iom_put( "heatc", rau0_rcp * z2d ) ! vertically integrated heat content (J/m2) 249 DO_3D_11_11( 1, jpkm1 ) 250 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 251 END_3D 252 CALL iom_put( "heatc", rho0_rcp * z2d ) ! vertically integrated heat content (J/m2) 279 253 ENDIF 280 254 281 255 IF( iom_use("saltc") ) THEN 282 256 z2d(:,:) = 0._wp 283 DO jk = 1, jpkm1 284 DO jj = 1, jpj 285 DO ji = 1, jpi 286 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 287 END DO 288 END DO 289 END DO 290 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 257 DO_3D_11_11( 1, jpkm1 ) 258 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 259 END_3D 260 CALL iom_put( "saltc", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 291 261 ENDIF 292 262 ! 293 263 IF( iom_use("salt2c") ) THEN 294 264 z2d(:,:) = 0._wp 295 DO jk = 1, jpkm1 296 DO jj = 1, jpj 297 DO ji = 1, jpi 298 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 299 END DO 300 END DO 301 END DO 302 CALL iom_put( "salt2c", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 265 DO_3D_11_11( 1, jpkm1 ) 266 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) 267 END_3D 268 CALL iom_put( "salt2c", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 303 269 ENDIF 304 270 ! 305 271 IF ( iom_use("eken") ) THEN 306 272 z3d(:,:,jpk) = 0._wp 307 DO jk = 1, jpkm1 308 DO jj = 2, jpj 309 DO ji = 2, jpi 310 zztmpx = 0.5 * ( un(ji-1,jj ,jk) + un(ji,jj,jk) ) 311 zztmpy = 0.5 * ( vn(ji ,jj-1,jk) + vn(ji,jj,jk) ) 312 z3d(ji,jj,jk) = 0.5 * ( zztmpx*zztmpx + zztmpy*zztmpy ) 313 END DO 314 END DO 315 END DO 273 DO_3D_00_00( 1, jpkm1 ) 274 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 275 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 276 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 277 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 278 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 279 END_3D 316 280 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 317 281 CALL iom_put( "eken", z3d ) ! kinetic energy … … 323 287 z3d(1,:, : ) = 0._wp 324 288 z3d(:,1, : ) = 0._wp 325 DO jk = 1, jpkm1 326 DO jj = 2, jpj 327 DO ji = 2, jpi 328 z3d(ji,jj,jk) = 0.25_wp * ( un(ji ,jj,jk) * un(ji ,jj,jk) * e1e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 329 & + un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 330 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1e2v(ji,jj ) * e3v_n(ji,jj ,jk) & 331 & + vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1e2v(ji,jj-1) * e3v_n(ji,jj-1,jk) ) & 332 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 333 END DO 334 END DO 335 END DO 336 289 DO_3D_00_00( 1, jpkm1 ) 290 z3d(ji,jj,jk) = 0.25_wp * ( uu(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 291 & + uu(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 292 & + vv(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) * e1e2v(ji,jj ) * e3v(ji,jj ,jk,Kmm) & 293 & + vv(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) ) & 294 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 295 END_3D 337 296 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 338 297 CALL iom_put( "ke", z3d ) ! kinetic energy 339 298 340 299 z2d(:,:) = 0._wp 341 DO jk = 1, jpkm1 342 DO jj = 1, jpj 343 DO ji = 1, jpi 344 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 345 END DO 346 END DO 347 END DO 300 DO_3D_11_11( 1, jpkm1 ) 301 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 302 END_3D 348 303 CALL iom_put( "ke_zint", z2d ) ! vertically integrated kinetic energy 349 304 350 305 ENDIF 351 306 ! 352 CALL iom_put( "hdiv", hdiv n) ! Horizontal divergence307 CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence 353 308 354 309 IF ( iom_use("relvor") .OR. iom_use("absvor") .OR. iom_use("potvor") ) THEN 355 310 356 311 z3d(:,:,jpk) = 0._wp 357 DO jk = 1, jpkm1 358 DO jj = 1, jpjm1 359 DO ji = 1, fs_jpim1 ! vector opt. 360 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 361 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) * r1_e1e2f(ji,jj) 362 END DO 363 END DO 364 END DO 312 DO_3D_00_00( 1, jpkm1 ) 313 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm) & 314 & - e1u(ji ,jj+1) * uu(ji ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm) ) * r1_e1e2f(ji,jj) 315 END_3D 365 316 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 366 317 CALL iom_put( "relvor", z3d ) ! relative vorticity 367 318 368 DO jk = 1, jpkm1 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 372 END DO 373 END DO 374 END DO 319 DO_3D_11_11( 1, jpkm1 ) 320 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 321 END_3D 375 322 CALL iom_put( "absvor", z3d ) ! absolute vorticity 376 323 377 DO jk = 1, jpkm1 378 DO jj = 1, jpjm1 379 DO ji = 1, fs_jpim1 ! vector opt. 380 ze3 = ( e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 381 & + e3t_n(ji,jj ,jk)*tmask(ji,jj ,jk) + e3t_n(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 382 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 383 ELSE ; ze3 = 0._wp 384 ENDIF 385 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 386 END DO 387 END DO 388 END DO 324 DO_3D_00_00( 1, jpkm1 ) 325 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) & 326 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 327 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 328 ELSE ; ze3 = 0._wp 329 ENDIF 330 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 331 END_3D 389 332 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 390 333 CALL iom_put( "potvor", z3d ) ! potential vorticity 391 334 392 335 ENDIF 393 394 336 ! 395 337 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN … … 397 339 z2d(:,:) = 0.e0 398 340 DO jk = 1, jpkm1 399 z3d(:,:,jk) = r au0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk)341 z3d(:,:,jk) = rho0 * uu(:,:,jk,Kmm) * e2u(:,:) * e3u(:,:,jk,Kmm) * umask(:,:,jk) 400 342 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 401 343 END DO … … 406 348 IF( iom_use("u_heattr") ) THEN 407 349 z2d(:,:) = 0._wp 408 DO jk = 1, jpkm1 409 DO jj = 2, jpjm1 410 DO ji = fs_2, fs_jpim1 ! vector opt. 411 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 412 END DO 413 END DO 414 END DO 350 DO_3D_00_00( 1, jpkm1 ) 351 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) ) 352 END_3D 415 353 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 416 354 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction … … 419 357 IF( iom_use("u_salttr") ) THEN 420 358 z2d(:,:) = 0.e0 421 DO jk = 1, jpkm1 422 DO jj = 2, jpjm1 423 DO ji = fs_2, fs_jpim1 ! vector opt. 424 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 425 END DO 426 END DO 427 END DO 359 DO_3D_00_00( 1, jpkm1 ) 360 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) ) 361 END_3D 428 362 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 429 363 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction … … 434 368 z3d(:,:,jpk) = 0.e0 435 369 DO jk = 1, jpkm1 436 z3d(:,:,jk) = r au0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk)370 z3d(:,:,jk) = rho0 * vv(:,:,jk,Kmm) * e1v(:,:) * e3v(:,:,jk,Kmm) * vmask(:,:,jk) 437 371 END DO 438 372 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 441 375 IF( iom_use("v_heattr") ) THEN 442 376 z2d(:,:) = 0.e0 443 DO jk = 1, jpkm1 444 DO jj = 2, jpjm1 445 DO ji = fs_2, fs_jpim1 ! vector opt. 446 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 447 END DO 448 END DO 449 END DO 377 DO_3D_00_00( 1, jpkm1 ) 378 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) ) 379 END_3D 450 380 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 451 381 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction … … 454 384 IF( iom_use("v_salttr") ) THEN 455 385 z2d(:,:) = 0._wp 456 DO jk = 1, jpkm1 457 DO jj = 2, jpjm1 458 DO ji = fs_2, fs_jpim1 ! vector opt. 459 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 460 END DO 461 END DO 462 END DO 386 DO_3D_00_00( 1, jpkm1 ) 387 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) ) 388 END_3D 463 389 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 464 390 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction … … 467 393 IF( iom_use("tosmint") ) THEN 468 394 z2d(:,:) = 0._wp 469 DO jk = 1, jpkm1 470 DO jj = 2, jpjm1 471 DO ji = fs_2, fs_jpim1 ! vector opt. 472 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) 473 END DO 474 END DO 475 END DO 395 DO_3D_00_00( 1, jpkm1 ) 396 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 397 END_3D 476 398 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 477 CALL iom_put( "tosmint", r au0 * z2d ) ! Vertical integral of temperature399 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature 478 400 ENDIF 479 401 IF( iom_use("somint") ) THEN 480 402 z2d(:,:)=0._wp 481 DO jk = 1, jpkm1 482 DO jj = 2, jpjm1 483 DO ji = fs_2, fs_jpim1 ! vector opt. 484 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 485 END DO 486 END DO 487 END DO 403 DO_3D_00_00( 1, jpkm1 ) 404 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 405 END_3D 488 406 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 489 CALL iom_put( "somint", r au0 * z2d ) ! Vertical integral of salinity407 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity 490 408 ENDIF 491 409 492 410 CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2) 493 411 ! 494 495 IF (ln_diatmb) CALL dia_tmb ! tmb values 496 497 IF (ln_dia25h) CALL dia_25h( kt ) ! 25h averaging 412 413 IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging 498 414 499 415 IF( ln_timing ) CALL timing_stop('dia_wri') … … 510 426 INTEGER, DIMENSION(2) :: ierr 511 427 !!---------------------------------------------------------------------- 512 ierr = 0 513 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 514 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 515 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 428 IF( nn_write == -1 ) THEN 429 dia_wri_alloc = 0 430 ELSE 431 ierr = 0 432 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 433 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 434 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 516 435 ! 517 dia_wri_alloc = MAXVAL(ierr) 518 CALL mpp_sum( 'diawri', dia_wri_alloc ) 436 dia_wri_alloc = MAXVAL(ierr) 437 CALL mpp_sum( 'diawri', dia_wri_alloc ) 438 ! 439 ENDIF 519 440 ! 520 441 END FUNCTION dia_wri_alloc 442 443 INTEGER FUNCTION dia_wri_alloc_abl() 444 !!---------------------------------------------------------------------- 445 ALLOCATE( ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 446 CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 447 ! 448 END FUNCTION dia_wri_alloc_abl 521 449 522 450 523 SUBROUTINE dia_wri( kt )451 SUBROUTINE dia_wri( kt, Kmm ) 524 452 !!--------------------------------------------------------------------- 525 453 !! *** ROUTINE dia_wri *** … … 534 462 !!---------------------------------------------------------------------- 535 463 INTEGER, INTENT( in ) :: kt ! ocean time-step index 464 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 536 465 ! 537 466 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 541 470 INTEGER :: ierr ! error code return from allocation 542 471 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 472 INTEGER :: ipka ! ABL 543 473 INTEGER :: jn, ierror ! local integers 544 474 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars … … 546 476 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 547 477 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 478 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 548 479 !!---------------------------------------------------------------------- 549 480 ! 550 481 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! 551 CALL dia_wri_state( 'output.init' )482 CALL dia_wri_state( Kmm, 'output.init' ) 552 483 ninist = 0 553 484 ENDIF … … 566 497 clop = "x" ! no use of the mask value (require less cpu time and otherwise the model crashes) 567 498 #if defined key_diainstant 568 zsto = nn_write * r dt499 zsto = nn_write * rn_Dt 569 500 clop = "inst("//TRIM(clop)//")" 570 501 #else 571 zsto=r dt502 zsto=rn_Dt 572 503 clop = "ave("//TRIM(clop)//")" 573 504 #endif 574 zout = nn_write * r dt575 zmax = ( nitend - nit000 + 1 ) * r dt505 zout = nn_write * rn_Dt 506 zmax = ( nitend - nit000 + 1 ) * rn_Dt 576 507 577 508 ! Define indices of the horizontal output zoom and vertical limit storage … … 579 510 ijmi = 1 ; ijma = jpj 580 511 ipk = jpk 512 IF(ln_abl) ipka = jpkam1 581 513 582 514 ! define time axis … … 593 525 594 526 ! Compute julian date from starting date of the run 595 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )527 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 596 528 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 597 529 IF(lwp)WRITE(numout,*) … … 615 547 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 616 548 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 617 & nit000-1, zjulian, r dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )549 & nit000-1, zjulian, rn_Dt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 618 550 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 619 551 & "m", ipk, gdept_1d, nz_T, "down" ) … … 651 583 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu 652 584 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 653 & nit000-1, zjulian, r dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )585 & nit000-1, zjulian, rn_Dt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 654 586 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 655 587 & "m", ipk, gdept_1d, nz_U, "down" ) … … 664 596 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv 665 597 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 666 & nit000-1, zjulian, r dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )598 & nit000-1, zjulian, rn_Dt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 667 599 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 668 600 & "m", ipk, gdept_1d, nz_V, "down" ) … … 677 609 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 678 610 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 679 & nit000-1, zjulian, r dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )611 & nit000-1, zjulian, rn_Dt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 680 612 CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw 681 613 & "m", ipk, gdepw_1d, nz_W, "down" ) 682 614 615 IF( ln_abl ) THEN 616 ! Define the ABL grid FILE ( nid_A ) 617 CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 618 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 619 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 620 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 621 & nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 622 CALL histvert( nid_A, "ght_abl", "Vertical T levels", & ! Vertical grid: gdept 623 & "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 624 ! ! Index of ocean points 625 ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 626 zw3d_abl(:,:,:) = 1._wp 627 CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A ) ! volume 628 CALL wheneq( jpi*jpj , zw3d_abl, 1, 1., ndex_hA, ndim_hA ) ! surface 629 DEALLOCATE(zw3d_abl) 630 ENDIF 683 631 684 632 ! Declare all the output fields as NETCDF variables … … 690 638 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 691 639 IF( .NOT.ln_linssh ) THEN 692 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t _n640 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t(:,:,:,Kmm) 693 641 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 694 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t _n642 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t(:,:,:,Kmm) 695 643 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 696 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t _n644 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t(:,:,:,Kmm) 697 645 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 698 646 ENDIF … … 711 659 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 712 660 IF( ln_linssh ) THEN 713 CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature" & ! emp * ts n(:,:,1,jp_tem)661 CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature" & ! emp * ts(:,:,1,jp_tem,Kmm) 714 662 & , "KgC/m2/s", & ! sosst_cd 715 663 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 716 CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity" & ! emp * ts n(:,:,1,jp_sal)664 CALL histdef( nid_T, "sosss_cd", "Concentration/Dilution term on salinity" & ! emp * ts(:,:,1,jp_sal,Kmm) 717 665 & , "KgPSU/m2/s",& ! sosss_cd 718 666 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 730 678 CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm 731 679 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 732 ! 680 ! 681 IF( ln_abl ) THEN 682 CALL histdef( nid_A, "t_abl", "Potential Temperature" , "K" , & ! t_abl 683 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 684 CALL histdef( nid_A, "q_abl", "Humidity" , "kg/kg" , & ! q_abl 685 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 686 CALL histdef( nid_A, "u_abl", "Atmospheric U-wind " , "m/s" , & ! u_abl 687 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 688 CALL histdef( nid_A, "v_abl", "Atmospheric V-wind " , "m/s" , & ! v_abl 689 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 690 CALL histdef( nid_A, "tke_abl", "Atmospheric TKE " , "m2/s2" , & ! tke_abl 691 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 692 CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s" , & ! avm_abl 693 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 694 CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2", & ! avt_abl 695 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 696 CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height " , "m", & ! pblh 697 & jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 698 #if defined key_si3 699 CALL histdef( nid_A, "oce_frac", "Fraction of open ocean" , " ", & ! ato_i 700 & jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 701 #endif 702 CALL histend( nid_A, snc4chunks=snc4set ) 703 ENDIF 704 ! 733 705 IF( ln_icebergs ) THEN 734 706 CALL histdef( nid_T, "calving" , "calving mass input" , "kg/s" , & … … 790 762 791 763 ! !!! nid_U : 3D 792 CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! u n764 CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! uu(:,:,:,Kmm) 793 765 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 794 766 IF( ln_wave .AND. ln_sdw) THEN … … 803 775 804 776 ! !!! nid_V : 3D 805 CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! v n777 CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vv(:,:,:,Kmm) 806 778 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 807 779 IF( ln_wave .AND. ln_sdw) THEN … … 816 788 817 789 ! !!! nid_W : 3D 818 CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! w n790 CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! ww 819 791 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 820 792 CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt … … 854 826 855 827 IF( .NOT.ln_linssh ) THEN 856 CALL histwrite( nid_T, "votemper", it, ts n(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content857 CALL histwrite( nid_T, "vosaline", it, ts n(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content858 CALL histwrite( nid_T, "sosstsst", it, ts n(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content859 CALL histwrite( nid_T, "sosaline", it, ts n(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content828 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! heat content 829 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! salt content 830 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface heat content 831 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface salinity content 860 832 ELSE 861 CALL histwrite( nid_T, "votemper", it, ts n(:,:,:,jp_tem) , ndim_T , ndex_T ) ! temperature862 CALL histwrite( nid_T, "vosaline", it, ts n(:,:,:,jp_sal) , ndim_T , ndex_T ) ! salinity863 CALL histwrite( nid_T, "sosstsst", it, ts n(:,:,1,jp_tem) , ndim_hT, ndex_hT ) ! sea surface temperature864 CALL histwrite( nid_T, "sosaline", it, ts n(:,:,1,jp_sal) , ndim_hT, ndex_hT ) ! sea surface salinity833 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T ) ! temperature 834 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) , ndim_T , ndex_T ) ! salinity 835 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) , ndim_hT, ndex_hT ) ! sea surface temperature 836 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) , ndim_hT, ndex_hT ) ! sea surface salinity 865 837 ENDIF 866 838 IF( .NOT.ln_linssh ) THEN 867 zw3d(:,:,:) = ( ( e3t _n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2868 CALL histwrite( nid_T, "vovvle3t", it, e3t _n (:,:,:) , ndim_T , ndex_T ) ! level thickness869 CALL histwrite( nid_T, "vovvldep", it, gdept _n(:,:,:) , ndim_T , ndex_T ) ! t-point depth839 zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 840 CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm) , ndim_T , ndex_T ) ! level thickness 841 CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T ) ! t-point depth 870 842 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 871 843 ENDIF 872 CALL histwrite( nid_T, "sossheig", it, ssh n, ndim_hT, ndex_hT ) ! sea surface height844 CALL histwrite( nid_T, "sossheig", it, ssh(:,:,Kmm) , ndim_hT, ndex_hT ) ! sea surface height 873 845 CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf ) , ndim_hT, ndex_hT ) ! upward water flux 874 846 CALL histwrite( nid_T, "sorunoff", it, rnf , ndim_hT, ndex_hT ) ! river runoffs … … 877 849 ! in linear free surface case) 878 850 IF( ln_linssh ) THEN 879 zw2d(:,:) = emp (:,:) * ts n(:,:,1,jp_tem)851 zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_tem,Kmm) 880 852 CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst 881 zw2d(:,:) = emp (:,:) * ts n(:,:,1,jp_sal)853 zw2d(:,:) = emp (:,:) * ts(:,:,1,jp_sal,Kmm) 882 854 CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sss 883 855 ENDIF … … 888 860 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 889 861 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 890 ! 862 ! 863 IF( ln_abl ) THEN 864 ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 865 IF( ln_mskland ) THEN 866 DO jk=1,jpka 867 zw3d_abl(:,:,jk) = tmask(:,:,1) 868 END DO 869 ELSE 870 zw3d_abl(:,:,:) = 1._wp 871 ENDIF 872 CALL histwrite( nid_A, "pblh" , it, pblh(:,:) *zw3d_abl(:,:,1 ), ndim_hA, ndex_hA ) ! pblh 873 CALL histwrite( nid_A, "u_abl" , it, u_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! u_abl 874 CALL histwrite( nid_A, "v_abl" , it, v_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! v_abl 875 CALL histwrite( nid_A, "t_abl" , it, tq_abl (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! t_abl 876 CALL histwrite( nid_A, "q_abl" , it, tq_abl (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! q_abl 877 CALL histwrite( nid_A, "tke_abl", it, tke_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! tke_abl 878 CALL histwrite( nid_A, "avm_abl", it, avm_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avm_abl 879 CALL histwrite( nid_A, "avt_abl", it, avt_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avt_abl 880 #if defined key_si3 881 CALL histwrite( nid_A, "oce_frac" , it, ato_i(:,:) , ndim_hA, ndex_hA ) ! ato_i 882 #endif 883 DEALLOCATE(zw3d_abl) 884 ENDIF 885 ! 891 886 IF( ln_icebergs ) THEN 892 887 ! … … 915 910 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 916 911 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 917 zw2d(:,:) = erp(:,:) * ts n(:,:,1,jp_sal) * tmask(:,:,1)912 zw2d(:,:) = erp(:,:) * ts(:,:,1,jp_sal,Kmm) * tmask(:,:,1) 918 913 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 919 914 ENDIF … … 928 923 #endif 929 924 930 CALL histwrite( nid_U, "vozocrtx", it, u n, ndim_U , ndex_U ) ! i-current925 CALL histwrite( nid_U, "vozocrtx", it, uu(:,:,:,Kmm) , ndim_U , ndex_U ) ! i-current 931 926 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress 932 927 933 CALL histwrite( nid_V, "vomecrty", it, v n, ndim_V , ndex_V ) ! j-current928 CALL histwrite( nid_V, "vomecrty", it, vv(:,:,:,Kmm) , ndim_V , ndex_V ) ! j-current 934 929 CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress 935 930 936 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 931 IF( ln_zad_Aimp ) THEN 932 CALL histwrite( nid_W, "vovecrtz", it, ww + wi , ndim_T, ndex_T ) ! vert. current 933 ELSE 934 CALL histwrite( nid_W, "vovecrtz", it, ww , ndim_T, ndex_T ) ! vert. current 935 ENDIF 937 936 CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. 938 937 CALL histwrite( nid_W, "votkeavm", it, avm , ndim_T, ndex_T ) ! T vert. eddy visc. coef. … … 954 953 CALL histclo( nid_V ) 955 954 CALL histclo( nid_W ) 955 IF(ln_abl) CALL histclo( nid_A ) 956 956 ENDIF 957 957 ! … … 961 961 #endif 962 962 963 SUBROUTINE dia_wri_state( cdfile_name )963 SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 964 964 !!--------------------------------------------------------------------- 965 965 !! *** ROUTINE dia_wri_state *** … … 974 974 !! File 'output.abort.nc' is created in case of abnormal job end 975 975 !!---------------------------------------------------------------------- 976 INTEGER , INTENT( in ) :: Kmm ! time level index 976 977 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 977 978 !! 978 INTEGER :: inum 979 INTEGER :: inum, jk 979 980 !!---------------------------------------------------------------------- 980 981 ! … … 983 984 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 984 985 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 985 986 #if defined key_si3 987 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 988 #else 989 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 990 #endif 991 992 CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) ) ! now temperature 993 CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) ) ! now salinity 994 CALL iom_rstput( 0, 0, inum, 'sossheig', sshn ) ! sea surface height 995 CALL iom_rstput( 0, 0, inum, 'vozocrtx', un ) ! now i-velocity 996 CALL iom_rstput( 0, 0, inum, 'vomecrty', vn ) ! now j-velocity 997 CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn ) ! now k-velocity 986 ! 987 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 988 ! 989 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 990 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity 991 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,Kmm) ) ! sea surface height 992 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm) ) ! now i-velocity 993 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity 994 IF( ln_zad_Aimp ) THEN 995 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi ) ! now k-velocity 996 ELSE 997 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity 998 ENDIF 999 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 1000 CALL iom_rstput( 0, 0, inum, 'ht' , ht ) ! now water column height 1001 ! 1002 IF ( ln_isf ) THEN 1003 IF (ln_isfcav_mlt) THEN 1004 CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav ) ! now k-velocity 1005 CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav ) ! now k-velocity 1006 CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav ) ! now k-velocity 1007 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) ) ! now k-velocity 1008 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) ) ! now k-velocity 1009 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 1010 END IF 1011 IF (ln_isfpar_mlt) THEN 1012 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) ) ! now k-velocity 1013 CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par ) ! now k-velocity 1014 CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par ) ! now k-velocity 1015 CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par ) ! now k-velocity 1016 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) ) ! now k-velocity 1017 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) ) ! now k-velocity 1018 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 1019 END IF 1020 END IF 1021 ! 998 1022 IF( ALLOCATED(ahtu) ) THEN 999 1023 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point … … 1011 1035 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 1012 1036 IF( .NOT.ln_linssh ) THEN 1013 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept _n) ! T-cell depth1014 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t _n) ! T-cell thickness1037 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm) ) ! T-cell depth 1038 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm) ) ! T-cell thickness 1015 1039 END IF 1016 1040 IF( ln_wave .AND. ln_sdw ) THEN … … 1019 1043 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 1020 1044 ENDIF 1021 1045 IF ( ln_abl ) THEN 1046 CALL iom_rstput ( 0, 0, inum, "uz1_abl", u_abl(:,:,2,nt_a ) ) ! now first level i-wind 1047 CALL iom_rstput ( 0, 0, inum, "vz1_abl", v_abl(:,:,2,nt_a ) ) ! now first level j-wind 1048 CALL iom_rstput ( 0, 0, inum, "tz1_abl", tq_abl(:,:,2,nt_a,1) ) ! now first level temperature 1049 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 1050 ENDIF 1051 ! 1052 CALL iom_close( inum ) 1053 ! 1022 1054 #if defined key_si3 1023 1055 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 1056 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 1024 1057 CALL ice_wri_state( inum ) 1058 CALL iom_close( inum ) 1025 1059 ENDIF 1026 1060 #endif 1027 ! 1028 CALL iom_close( inum ) 1029 ! 1061 1030 1062 END SUBROUTINE dia_wri_state 1031 1063
Note: See TracChangeset
for help on using the changeset viewer.
