- Timestamp:
- 2016-06-09T18:34:00+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 8 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6462 r6679 95 95 CALL iom_put( 'voltot', zvol ) 96 96 CALL iom_put( 'sshtot', zvolssh / area_tot ) 97 CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 97 98 98 99 ! -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6463 r6679 21 21 USE dom_oce ! ocean space and time domain 22 22 USE phycst ! physical constants 23 USE ldftra_oce 23 24 ! 24 25 USE iom ! IOM library … … 41 42 42 43 ! !!** namelist namptr ** 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 45 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv, htr_vt !: Heat TRansports (adv, diff, Bolus.) 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv, str_vs !: Salt TRansports (adv, diff, Bolus.) 46 46 47 47 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) … … 210 210 ENDDO 211 211 ENDIF 212 213 ENDIF 212 ENDIF 213 214 IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN 215 z2d(1,:) = htr_vt(:,1) * rc_pwatt ! (conversion in PW) 216 DO ji = 1, jpi 217 z2d(ji,:) = z2d(1,:) 218 ENDDO 219 cl1 = 'sopht_vt' 220 CALL iom_put( TRIM(cl1), z2d ) 221 z2d(1,:) = str_vs(:,1) * rc_ggram ! (conversion in Gg) 222 DO ji = 1, jpi 223 z2d(ji,:) = z2d(1,:) 224 ENDDO 225 cl1 = 'sopst_vs' 226 CALL iom_put( TRIM(cl1), z2d ) 227 IF( ln_subbas ) THEN 228 DO jn=2,nptr 229 z2d(1,:) = htr_vt(:,jn) * rc_pwatt ! (conversion in PW) 230 DO ji = 1, jpi 231 z2d(ji,:) = z2d(1,:) 232 ENDDO 233 cl1 = TRIM('sopht_vt_'//clsubb(jn)) 234 CALL iom_put( cl1, z2d ) 235 z2d(1,:) = str_vs(:,jn) * rc_ggram ! (conversion in Gg) 236 DO ji = 1, jpi 237 z2d(ji,:) = z2d(1,:) 238 ENDDO 239 cl1 = TRIM('sopst_vs_'//clsubb(jn)) 240 CALL iom_put( cl1, z2d ) 241 ENDDO 242 ENDIF 243 ENDIF 244 245 #ifdef key_diaeiv 246 IF(lk_traldf_eiv) THEN 247 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 248 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 249 DO ji = 1, jpi 250 z2d(ji,:) = z2d(1,:) 251 ENDDO 252 cl1 = 'sophteiv' 253 CALL iom_put( TRIM(cl1), z2d ) 254 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 255 DO ji = 1, jpi 256 z2d(ji,:) = z2d(1,:) 257 ENDDO 258 cl1 = 'sopsteiv' 259 CALL iom_put( TRIM(cl1), z2d ) 260 IF( ln_subbas ) THEN 261 DO jn=2,nptr 262 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 263 DO ji = 1, jpi 264 z2d(ji,:) = z2d(1,:) 265 ENDDO 266 cl1 = TRIM('sophteiv_'//clsubb(jn)) 267 CALL iom_put( cl1, z2d ) 268 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 269 DO ji = 1, jpi 270 z2d(ji,:) = z2d(1,:) 271 ENDDO 272 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 273 CALL iom_put( cl1, z2d ) 274 ENDDO 275 ENDIF 276 ENDIF 277 ENDIF 278 #endif 214 279 ! 215 280 ENDIF … … 292 357 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 293 358 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 359 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 360 htr_vt(:,:) = 0._wp ; str_vs(:,:) = 0._wp 294 361 ! 295 362 ENDIF … … 305 372 !!---------------------------------------------------------------------- 306 373 INTEGER , INTENT(in ) :: ktra ! tracer index 307 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 374 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 308 375 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 309 376 INTEGER :: jn ! … … 318 385 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 319 386 ENDIF 387 IF( cptr == 'eiv' ) THEN 388 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 389 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 390 ENDIF 391 IF( cptr == 'vts' ) THEN 392 IF( ktra == jp_tem ) htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 393 IF( ktra == jp_sal ) str_vs(:,1) = ptr_sj( pva(:,:,:) ) 394 ENDIF 320 395 ! 321 396 IF( ln_subbas ) THEN … … 345 420 ENDIF 346 421 ENDIF 422 IF( cptr == 'eiv' ) THEN 423 IF( ktra == jp_tem ) THEN 424 DO jn = 2, nptr 425 htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 426 END DO 427 ENDIF 428 IF( ktra == jp_sal ) THEN 429 DO jn = 2, nptr 430 str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 431 END DO 432 ENDIF 433 ENDIF 434 IF( cptr == 'vts' ) THEN 435 IF( ktra == jp_tem ) THEN 436 DO jn = 2, nptr 437 htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 438 END DO 439 ENDIF 440 IF( ktra == jp_sal ) THEN 441 DO jn = 2, nptr 442 str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 443 END DO 444 ENDIF 445 ENDIF 347 446 ! 348 447 ENDIF … … 362 461 ALLOCATE( btmsk(jpi,jpj,nptr) , & 363 462 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 463 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 464 & htr_vt(jpj,nptr) , str_vs(jpj,nptr) , & 364 465 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 365 466 ! -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6462 r6679 308 308 ENDIF 309 309 310 IF( iom_use("u_masstr") .OR. iom_use("u_ heattr") .OR. iom_use("u_salttr") ) THEN310 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 311 311 z3d(:,:,jpk) = 0.e0 312 z2d(:,:) = 0.e0 312 313 DO jk = 1, jpkm1 313 314 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 315 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 314 316 END DO 315 317 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 318 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 316 319 ENDIF 317 320 … … 376 379 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 377 380 ENDIF 381 382 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 378 383 ! 379 384 CALL wrk_dealloc( jpi , jpj , z2d ) -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r6462 r6679 193 193 ! automatic definitions of some of the xml attributs 194 194 CALL set_xmlatt 195 196 CALL set_1point 195 197 196 198 ! end file definition … … 1457 1459 1458 1460 END SUBROUTINE set_scalar 1461 1462 SUBROUTINE set_1point 1463 !!---------------------------------------------------------------------- 1464 !! *** ROUTINE set_1point *** 1465 !! 1466 !! ** Purpose : define zoom grid for scalar fields 1467 !! 1468 !!---------------------------------------------------------------------- 1469 REAL(wp), DIMENSION(1) :: zz = 1. 1470 INTEGER :: ix, iy 1471 !!---------------------------------------------------------------------- 1472 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! Nearest point to north pole should be ocean 1473 CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 1474 1475 END SUBROUTINE set_1point 1459 1476 1460 1477 -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6462 r6679 1405 1405 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1406 1406 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1407 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1407 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1) ) ! liquid precipitation 1408 CALL iom_put( 'rain_ao_cea' , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1) ) ! liquid precipitation 1408 1409 IF( iom_use('hflx_rain_cea') ) & 1409 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip.1410 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1)) ! heat flux from liq. precip. 1410 1411 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1411 1412 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1412 1413 IF( iom_use('evap_ao_cea' ) ) & 1413 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average)1414 CALL iom_put( 'evap_ao_cea' , ztmp * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1414 1415 IF( iom_use('hflx_evap_cea') ) & 1415 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average)1416 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from from evap (cell average) 1416 1417 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1417 1418 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1421 1422 END SELECT 1422 1423 1424 #if defined key_lim3 1425 ! zsnw = snow percentage over ice after wind blowing 1426 zsnw(:,:) = 0._wp 1427 CALL lim_thd_snwblow( p_frld, zsnw ) 1428 1429 ! --- evaporation (kg/m2/s) --- ! 1430 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1431 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1432 ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 1433 zdevap_ice(:,:) = 0._wp 1434 1435 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1436 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1437 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1438 1439 ! Sublimation over sea-ice (cell average) 1423 1440 IF( iom_use('subl_ai_cea') ) & 1424 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1425 ! 1426 ! !runoffs and calving (put in emp_tot)1441 CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 1442 1443 ! runoffs and calving (put in emp_tot) 1427 1444 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1445 IF( srcv(jpr_cal)%laction ) THEN 1446 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1447 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1448 ENDIF 1449 1450 IF( ln_mixcpl ) THEN 1451 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1452 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1453 emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 1454 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1455 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1456 ELSE 1457 DO jl=1,jpl 1458 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1459 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1460 ENDDO 1461 ELSE 1462 emp_tot(:,:) = zemp_tot(:,:) 1463 emp_ice(:,:) = zemp_ice(:,:) 1464 emp_oce(:,:) = zemp_oce(:,:) 1465 sprecip(:,:) = zsprecip(:,:) 1466 tprecip(:,:) = ztprecip(:,:) 1467 DO jl=1,jpl 1468 evap_ice (:,:,jl) = zevap_ice (:,:) 1469 devap_ice(:,:,jl) = zdevap_ice(:,:) 1470 ENDDO 1471 ENDIF 1472 1473 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1474 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1475 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1476 #else 1477 ! Sublimation over sea-ice (cell average) 1478 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 1479 ! runoffs and calving (put in emp_tot) 1480 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1481 IF( iom_use('hflx_rnf_cea') ) & 1482 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 1428 1483 IF( srcv(jpr_cal)%laction ) THEN 1429 1484 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) … … 1443 1498 ENDIF 1444 1499 1445 CALL iom_put( 'snowpre' , sprecip 1500 CALL iom_put( 'snowpre' , sprecip * tmask(:,:,1) ) ! Snow 1446 1501 IF( iom_use('snow_ao_cea') ) & 1447 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) 1502 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) * tmask(:,:,1) ) ! Snow over ice-free ocean (cell average) 1448 1503 IF( iom_use('snow_ai_cea') ) & 1449 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) 1450 1504 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) * tmask(:,:,1) ) ! Snow over sea-ice (cell average) 1505 #endif 1451 1506 ! ! ========================= ! 1452 1507 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r6462 r6679 28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing 30 USE diaptr ! Heat/Salt transport diagnostics 30 31 31 32 IMPLICIT NONE … … 78 79 # endif 79 80 REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d 80 82 !!---------------------------------------------------------------------- 81 83 ! … … 84 86 # if defined key_diaeiv 85 87 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 88 IF( ln_diaptr ) CALL wrk_alloc( jpi, jpj, jpk, z3d ) 86 89 # else 87 90 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) … … 160 163 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 161 164 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 165 IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value 166 z2d(:,:) = rau0 * e12t(:,:) 167 DO jk = 1, jpk 168 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 169 END DO 170 CALL iom_put( "weiv_masstr" , z3d ) 171 ENDIF 172 IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") ) THEN 173 z3d(:,:,jpk) = 0.e0 174 z2d(:,:) = 0.e0 175 DO jk = 1, jpkm1 176 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 177 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 178 END DO 179 CALL iom_put( "ueiv_masstr", z3d ) ! mass transport in i-direction 180 ENDIF 181 162 182 IF( iom_use('ueiv_heattr') ) THEN 163 183 zztmp = 0.5 * rau0 * rcp … … 166 186 DO jj = 2, jpjm1 167 187 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) 188 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 170 189 END DO 171 190 END DO … … 174 193 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! heat transport in i-direction 175 194 ENDIF 195 196 IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") ) THEN 197 z3d(:,:,jpk) = 0.e0 198 z2d(:,:) = 0.e0 199 DO jk = 1, jpkm1 200 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 201 END DO 202 CALL iom_put( "veiv_masstr", z3d ) ! mass transport in j-direction 203 ENDIF 176 204 177 205 IF( iom_use('veiv_heattr') ) THEN 178 zztmp = 0.5 * rau0 * rcp179 206 z2d(:,:) = 0.e0 180 207 DO jk = 1, jpkm1 181 208 DO jj = 2, jpjm1 182 209 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) 210 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 185 211 END DO 186 212 END DO … … 190 216 ENDIF 191 217 END IF 218 ! 219 IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 220 z3d(:,:,:) = 0._wp 221 DO jk = 1, jpkm1 222 DO jj = 2, jpjm1 223 DO ji = fs_2, fs_jpim1 ! vector opt. 224 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 225 & * e1v(ji,jj) * fse3v(ji,jj,jk) 226 END DO 227 END DO 228 END DO 229 CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 230 z3d(:,:,:) = 0._wp 231 DO jk = 1, jpkm1 232 DO jj = 2, jpjm1 233 DO ji = fs_2, fs_jpim1 ! vector opt. 234 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 235 & * e1v(ji,jj) * fse3v(ji,jj,jk) 236 END DO 237 END DO 238 END DO 239 CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 240 ENDIF 192 241 # endif 193 ! 242 194 243 # if defined key_diaeiv 195 244 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 245 IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 196 246 # else 197 247 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6463 r6679 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 … … 85 87 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 86 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 88 REAL(wp), POINTER, DIMENSION(:,: ,:) :: zptry89 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, z2d, zptry 90 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 89 91 !!---------------------------------------------------------------------- 90 92 ! … … 99 101 ! 100 102 l_trd = .FALSE. 103 l_trans = .FALSE. 101 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 102 106 ENDIF 103 107 ! 104 IF( l_trd ) THEN108 IF( l_trd .OR. l_trans ) THEN 105 109 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 106 110 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 111 CALL wrk_alloc( jpi, jpj, z2d ) 107 112 ENDIF 108 113 ! … … 194 199 195 200 ! ! trend diagnostics (contribution of upstream fluxes) 196 IF( l_trd ) THEN201 IF( l_trd .OR. l_trans ) THEN 197 202 ! store intermediate advective trends 198 203 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) … … 257 262 258 263 ! ! trend diagnostics (contribution of upstream fluxes) 259 IF( l_trd ) THEN264 IF( l_trd .OR. l_trans ) THEN 260 265 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 261 266 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 262 267 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 263 264 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 265 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 266 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 268 ENDIF 269 270 IF( l_trd ) THEN 271 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 272 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 273 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 267 274 END IF 268 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 275 276 IF( l_trans .AND. jn==jp_tem ) THEN 277 z2d(:,:) = 0._wp 278 DO jk = 1, jpkm1 279 DO jj = 2, jpjm1 280 DO ji = fs_2, fs_jpim1 ! vector opt. 281 z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 282 END DO 283 END DO 284 END DO 285 CALL lbc_lnk( z2d, 'U', -1. ) 286 CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! heat transport in i-direction 287 ! 288 z2d(:,:) = 0._wp 289 DO jk = 1, jpkm1 290 DO jj = 2, jpjm1 291 DO ji = fs_2, fs_jpim1 ! vector opt. 292 z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 293 END DO 294 END DO 295 END DO 296 CALL lbc_lnk( z2d, 'V', -1. ) 297 CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! heat transport in j-direction 298 ENDIF 299 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 269 300 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 270 301 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed … … 274 305 END DO 275 306 ! 276 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 277 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 307 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 308 IF( l_trd .OR. l_trans ) THEN 309 CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 310 CALL wrk_dealloc( jpi, jpj, z2d ) 311 ENDIF 278 312 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 279 313 ! -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/step.F90
r6462 r6679 231 231 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 232 232 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 233 CALL dia_prod( kstp ) ! ocean model: product diagnostics 233 234 CALL dia_wri( kstp ) ! ocean model: outputs 234 235 !
Note: See TracChangeset
for help on using the changeset viewer.