- Timestamp:
- 2015-07-21T10:55:28+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5038 r5620 44 44 USE in_out_manager ! I/O manager 45 45 USE diadimg ! dimg direct access file format output 46 <<<<<<< .working47 USE diaar5, ONLY : lk_diaar548 =======49 >>>>>>> .merge-right.r503550 46 USE iom 51 47 USE ioipsl 48 USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities 49 52 50 #if defined key_lim2 53 51 USE limwri_2 … … 82 80 !!---------------------------------------------------------------------- 83 81 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 84 !! $Id 82 !! $Id$ 85 83 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 86 84 !!---------------------------------------------------------------------- … … 129 127 !! 130 128 INTEGER :: ji, jj, jk ! dummy loop indices 129 INTEGER :: jkbot ! 131 130 REAL(wp) :: zztmp, zztmpx, zztmpy ! 132 131 !! 133 <<<<<<< .working134 132 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 135 REAL(wp), POINTER, DIMENSION(:,:) :: z2ds ! 2D workspace136 =======137 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace138 >>>>>>> .merge-right.r5035139 133 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 140 134 !!---------------------------------------------------------------------- … … 142 136 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 143 137 ! 144 CALL wrk_alloc( jpi , jpj , z2d , z2ds)138 CALL wrk_alloc( jpi , jpj , z2d ) 145 139 CALL wrk_alloc( jpi , jpj, jpk , z3d ) 146 140 ! … … 151 145 ENDIF 152 146 153 IF( lk_vvl ) THEN 154 z3d(:,:,:) = tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) 155 CALL iom_put( "toce" , z3d ) ! heat content 147 IF( .NOT.lk_vvl ) THEN 148 CALL iom_put( "e3t" , fse3t_n(:,:,:) ) 149 CALL iom_put( "e3u" , fse3u_n(:,:,:) ) 150 CALL iom_put( "e3v" , fse3v_n(:,:,:) ) 151 CALL iom_put( "e3w" , fse3w_n(:,:,:) ) 152 ENDIF 153 154 CALL iom_put( "ssh" , sshn ) ! sea surface height 155 if( iom_use('ssh2') ) CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height 156 157 CALL iom_put( "toce", tsn(:,:,:,jp_tem) ) ! 3D temperature 158 CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature 159 IF ( iom_use("sbt") ) THEN 156 160 DO jj = 1, jpj 157 161 DO ji = 1, jpi 158 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * fse3t_n(ji,jj,mikt(ji,jj)) 159 END DO 160 END DO 161 CALL iom_put( "sst" , z2d(:,:) ) ! sea surface heat content 162 jkbot = mbkt(ji,jj) 163 z2d(ji,jj) = tsn(ji,jj,jkbot,jp_tem) 164 END DO 165 END DO 166 CALL iom_put( "sbt", z2d ) ! bottom temperature 167 ENDIF 168 169 CALL iom_put( "soce", tsn(:,:,:,jp_sal) ) ! 3D salinity 170 CALL iom_put( "sss", tsn(:,:,1,jp_sal) ) ! surface salinity 171 IF ( iom_use("sbs") ) THEN 162 172 DO jj = 1, jpj 163 173 DO ji = 1, jpi 164 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem)**2 * fse3t_n(ji,jj,mikt(ji,jj)) 165 END DO 166 END DO 167 CALL iom_put( "sst2" , z2d(:,:) ) ! sea surface content of squared temperature 168 z3d(:,:,:) = tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) 169 CALL iom_put( "soce" , z3d ) ! salinity content 174 jkbot = mbkt(ji,jj) 175 z2d(ji,jj) = tsn(ji,jj,jkbot,jp_sal) 176 END DO 177 END DO 178 CALL iom_put( "sbs", z2d ) ! bottom salinity 179 ENDIF 180 181 IF ( iom_use("taubot") ) THEN ! bottom stress 182 z2d(:,:) = 0._wp 183 DO jj = 2, jpjm1 184 DO ji = fs_2, fs_jpim1 ! vector opt. 185 zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) & 186 & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) ) 187 zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) & 188 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) ) 189 z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 190 ! 191 ENDDO 192 ENDDO 193 CALL lbc_lnk( z2d, 'T', 1. ) 194 CALL iom_put( "taubot", z2d ) 195 ENDIF 196 197 CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current 198 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current 199 IF ( iom_use("sbu") ) THEN 170 200 DO jj = 1, jpj 171 201 DO ji = 1, jpi 172 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * fse3t_n(ji,jj,mikt(ji,jj)) 173 END DO 174 END DO 175 CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity content 202 jkbot = mbku(ji,jj) 203 z2d(ji,jj) = un(ji,jj,jkbot) 204 END DO 205 END DO 206 CALL iom_put( "sbu", z2d ) ! bottom i-current 207 ENDIF 208 #if defined key_dynspg_ts 209 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current 210 #else 211 CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current 212 #endif 213 214 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current 215 CALL iom_put( "ssv", vn(:,:,1) ) ! surface j-current 216 IF ( iom_use("sbv") ) THEN 176 217 DO jj = 1, jpj 177 218 DO ji = 1, jpi 178 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal)**2 * fse3t_n(ji,jj,mikt(ji,jj)) 179 END DO 180 END DO 181 CALL iom_put( "sss2" , z2d(:,:) ) ! sea surface content of squared salinity 182 ELSE 183 CALL iom_put( "toce" , tsn(:,:,:,jp_tem) ) ! temperature 184 IF ( iom_use("sst") ) THEN 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) 188 END DO 189 END DO 190 CALL iom_put( "sst" , z2d(:,:) ) ! sea surface temperature 191 ENDIF 192 IF ( iom_use("sst2") ) CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature 193 CALL iom_put( "soce" , tsn(:,:,:,jp_sal) ) ! salinity 194 IF ( iom_use("sss") ) THEN 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) 198 END DO 199 END DO 200 CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity 201 ENDIF 202 CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity 203 END IF 204 IF( lk_vvl .AND. (.NOT. ln_dynadv_vec) ) THEN 205 CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) * fse3u_n(:,:,:) ) ! i-transport 206 CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) * fse3v_n(:,:,:) ) ! j-transport 207 ELSE 208 CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) ) ! i-current 209 CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) ) ! j-current 210 IF ( iom_use("ssu") ) THEN 211 DO jj = 1, jpj 212 DO ji = 1, jpi 213 z2d(ji,jj) = un(ji,jj,miku(ji,jj)) 214 END DO 215 END DO 216 CALL iom_put( "ssu" , z2d ) ! i-current 217 ENDIF 218 IF ( iom_use("ssv") ) THEN 219 DO jj = 1, jpj 220 DO ji = 1, jpi 221 z2d(ji,jj) = vn(ji,jj,mikv(ji,jj)) 222 END DO 223 END DO 224 CALL iom_put( "ssv" , z2d ) ! j-current 225 ENDIF 226 ENDIF 227 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 228 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 229 IF( lk_zdfddm ) THEN 230 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. 231 ENDIF 232 233 IF ( iom_use("sstgrad2") .OR. iom_use("sstgrad2") ) THEN 219 jkbot = mbkv(ji,jj) 220 z2d(ji,jj) = vn(ji,jj,jkbot) 221 END DO 222 END DO 223 CALL iom_put( "sbv", z2d ) ! bottom j-current 224 ENDIF 225 #if defined key_dynspg_ts 226 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current 227 #else 228 CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current 229 #endif 230 231 CALL iom_put( "woce", wn ) ! vertical velocity 232 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 233 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 234 z2d(:,:) = rau0 * e12t(:,:) 235 DO jk = 1, jpk 236 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 237 END DO 238 CALL iom_put( "w_masstr" , z3d ) 239 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 240 ENDIF 241 242 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 243 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 244 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm) 245 246 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 234 247 DO jj = 2, jpjm1 ! sst gradient 235 248 DO ji = fs_2, fs_jpim1 ! vector opt. … … 243 256 CALL lbc_lnk( z2d, 'T', 1. ) 244 257 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 245 !CDIR NOVERRCHK<246 258 z2d(:,:) = SQRT( z2d(:,:) ) 247 259 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient … … 252 264 z2d(:,:) = 0._wp 253 265 DO jk = 1, jpkm1 254 DO jj = 2, jpjm1255 DO ji = fs_2, fs_jpim1 ! vector opt.266 DO jj = 1, jpj 267 DO ji = 1, jpi 256 268 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 257 269 END DO 258 270 END DO 259 271 END DO 260 CALL lbc_lnk( z2d, 'T', 1. )261 272 CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2) 262 273 ENDIF 263 274 264 <<<<<<< .working265 ! clem: heat and salt content266 z2d(:,:) = 0._wp267 z2ds(:,:) = 0._wp268 DO jk = 1, jpkm1269 DO jj = 2, jpjm1270 DO ji = fs_2, fs_jpim1 ! vector opt.271 z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)272 z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)273 END DO274 END DO275 END DO276 CALL lbc_lnk( z2d, 'T', 1. )277 CALL lbc_lnk( z2ds, 'T', 1. )278 CALL iom_put( "heatc", z2d ) ! vertically integrated heat content (J/m2)279 CALL iom_put( "saltc", z2ds ) ! vertically integrated salt content (PSU*kg/m2)280 281 282 IF( lk_diaar5 ) THEN283 =======284 275 IF( iom_use("saltc") ) THEN 285 276 z2d(:,:) = 0._wp 286 277 DO jk = 1, jpkm1 287 DO jj = 2, jpjm1288 DO ji = fs_2, fs_jpim1 ! vector opt.278 DO jj = 1, jpj 279 DO ji = 1, jpi 289 280 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 290 281 END DO 291 282 END DO 292 283 END DO 293 CALL lbc_lnk( z2d, 'T', 1. )294 284 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 295 285 ENDIF … … 319 309 320 310 IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 321 >>>>>>> .merge-right.r5035322 311 z3d(:,:,jpk) = 0.e0 323 312 DO jk = 1, jpkm1 … … 325 314 END DO 326 315 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 327 <<<<<<< .working328 329 zztmp = 0.5 * rcp330 =======331 316 ENDIF 332 317 333 318 IF( iom_use("u_heattr") ) THEN 334 >>>>>>> .merge-right.r5035335 319 z2d(:,:) = 0.e0 336 z2ds(:,:) = 0.e0337 320 DO jk = 1, jpkm1 338 321 DO jj = 2, jpjm1 339 322 DO ji = fs_2, fs_jpim1 ! vector opt. 340 323 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 341 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )342 324 END DO 343 325 END DO 344 326 END DO 345 327 CALL lbc_lnk( z2d, 'U', -1. ) 346 <<<<<<< .working347 CALL lbc_lnk( z2ds, 'U', -1. )348 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction349 =======350 328 CALL iom_put( "u_heattr", (0.5 * rcp) * z2d ) ! heat transport in i-direction 351 329 ENDIF … … 353 331 IF( iom_use("u_salttr") ) THEN 354 332 z2d(:,:) = 0.e0 355 >>>>>>> .merge-right.r5035356 CALL iom_put( "u_salttr", z2ds ) ! salt transport in i-direction357 358 z3d(:,:,jpk) = 0.e0359 333 DO jk = 1, jpkm1 360 <<<<<<< .working361 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk)362 =======363 334 DO jj = 2, jpjm1 364 335 DO ji = fs_2, fs_jpim1 ! vector opt. … … 366 337 END DO 367 338 END DO 368 >>>>>>> .merge-right.r5035369 339 END DO 370 340 CALL lbc_lnk( z2d, 'U', -1. ) … … 379 349 END DO 380 350 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 381 <<<<<<< .working382 383 =======384 351 ENDIF 385 352 386 353 IF( iom_use("v_heattr") ) THEN 387 >>>>>>> .merge-right.r5035388 354 z2d(:,:) = 0.e0 389 z2ds(:,:) = 0.e0390 355 DO jk = 1, jpkm1 391 356 DO jj = 2, jpjm1 392 357 DO ji = fs_2, fs_jpim1 ! vector opt. 393 358 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 394 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) )395 359 END DO 396 360 END DO 397 361 END DO 398 362 CALL lbc_lnk( z2d, 'V', -1. ) 399 <<<<<<< .working400 CALL lbc_lnk( z2ds, 'V', -1. )401 CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction402 CALL iom_put( "v_salttr", z2ds ) ! salt transport in j-direction403 =======404 363 CALL iom_put( "v_heattr", (0.5 * rcp) * z2d ) ! heat transport in j-direction 405 >>>>>>> .merge-right.r5035406 364 ENDIF 407 365 … … 419 377 ENDIF 420 378 ! 421 CALL wrk_dealloc( jpi , jpj , z2d , z2ds)379 CALL wrk_dealloc( jpi , jpj , z2d ) 422 380 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 423 381 ! … … 480 438 zdt = rdt 481 439 IF( nacc == 1 ) zdt = rdtmin 482 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 483 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 484 ENDIF 440 clop = "x" ! no use of the mask value (require less cpu time and otherwise the model crashes) 485 441 #if defined key_diainstant 486 442 zsto = nwrite * zdt … … 682 638 ENDIF 683 639 684 IF( .NOT. l k_cpl ) THEN640 IF( .NOT. ln_cpl ) THEN 685 641 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 686 642 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 691 647 ENDIF 692 648 693 IF( l k_cpl .AND. nn_ice <= 1 ) THEN649 IF( ln_cpl .AND. nn_ice <= 1 ) THEN 694 650 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 695 651 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 714 670 #endif 715 671 716 IF( l k_cpl .AND. nn_ice == 2 ) THEN672 IF( ln_cpl .AND. nn_ice == 2 ) THEN 717 673 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice 718 674 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 869 825 ENDIF 870 826 871 IF( .NOT. l k_cpl ) THEN827 IF( .NOT. ln_cpl ) THEN 872 828 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 873 829 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping … … 875 831 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 876 832 ENDIF 877 IF( l k_cpl .AND. nn_ice <= 1 ) THEN833 IF( ln_cpl .AND. nn_ice <= 1 ) THEN 878 834 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 879 835 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping … … 891 847 #endif 892 848 893 IF( l k_cpl .AND. nn_ice == 2 ) THEN849 IF( ln_cpl .AND. nn_ice == 2 ) THEN 894 850 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature 895 851 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo
Note: See TracChangeset
for help on using the changeset viewer.
