Changeset 6731 for branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2016-06-22T13:43:26+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6486 r6731 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_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90
r6491 r6731 25 25 USE timing ! preformance summary 26 26 USE wrk_nemo ! working array 27 USE diaptr 27 28 28 29 IMPLICIT NONE … … 98 99 ENDIF 99 100 100 IF( iom_use("vt") ) THEN101 IF( iom_use("vt") .OR. iom_use("sopht_vt") ) THEN 101 102 z3d(:,:,:) = 0.e0 102 103 DO jk = 1, jpkm1 … … 108 109 END DO 109 110 CALL iom_put( "vt", z3d ) ! product of temperature and meridional velocity at V points 111 DO jk = 1, jpkm1 112 DO jj = 2, jpjm1 113 DO ji = fs_2, fs_jpim1 ! vector opt. 114 z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 115 END DO 116 END DO 117 END DO 118 CALL dia_ptr_ohst_components( jp_tem, 'vts', z3d) 110 119 ENDIF 111 120 … … 139 148 ENDIF 140 149 141 IF( iom_use("vs") ) THEN150 IF( iom_use("vs") .OR. iom_use("sopst_vs") ) THEN 142 151 z3d(:,:,:) = 0.e0 143 152 DO jk = 1, jpkm1 … … 149 158 END DO 150 159 CALL iom_put( "vs", z3d ) ! product of salinity and meridional velocity at V points 160 DO jk = 1, jpkm1 161 DO jj = 2, jpjm1 162 DO ji = fs_2, fs_jpim1 ! vector opt. 163 z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 164 END DO 165 END DO 166 END DO 167 CALL dia_ptr_ohst_components( jp_sal, 'vts', z3d) 151 168 ENDIF 152 169 -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6486 r6731 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 … … 38 39 PUBLIC dia_ptr_init ! call in step module 39 40 PUBLIC dia_ptr ! call in step module 41 PUBLIC dia_ptr_ohst_components ! called from tra_ldf/tra_adv routines 40 42 41 43 ! !!** namelist namptr ** 42 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 44 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.) 45 46 46 47 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 47 48 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 48 INTEGER 49 INTEGER, PUBLIC :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 49 50 50 51 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 82 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 83 84 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 84 CHARACTER( len = 1 0) :: cl185 CHARACTER( len = 12 ) :: cl1 85 86 !!---------------------------------------------------------------------- 86 87 ! … … 150 151 ! ! Advective and diffusive heat and salt transport 151 152 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 152 z2d(1,:) = htr_adv(: ) * rc_pwatt ! (conversion in PW)153 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 153 154 DO ji = 1, jpi 154 155 z2d(ji,:) = z2d(1,:) … … 156 157 cl1 = 'sophtadv' 157 158 CALL iom_put( TRIM(cl1), z2d ) 158 z2d(1,:) = str_adv(: ) * rc_ggram ! (conversion in Gg)159 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 159 160 DO ji = 1, jpi 160 161 z2d(ji,:) = z2d(1,:) … … 162 163 cl1 = 'sopstadv' 163 164 CALL iom_put( TRIM(cl1), z2d ) 165 IF( ln_subbas ) THEN 166 DO jn=2,nptr 167 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 168 DO ji = 1, jpi 169 z2d(ji,:) = z2d(1,:) 170 ENDDO 171 cl1 = TRIM('sophtadv_'//clsubb(jn)) 172 CALL iom_put( cl1, z2d ) 173 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 174 DO ji = 1, jpi 175 z2d(ji,:) = z2d(1,:) 176 ENDDO 177 cl1 = TRIM('sopstadv_'//clsubb(jn)) 178 CALL iom_put( cl1, z2d ) 179 ENDDO 180 ENDIF 164 181 ENDIF 165 182 ! 166 183 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 167 z2d(1,:) = htr_ldf(: ) * rc_pwatt ! (conversion in PW)184 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 168 185 DO ji = 1, jpi 169 186 z2d(ji,:) = z2d(1,:) … … 171 188 cl1 = 'sophtldf' 172 189 CALL iom_put( TRIM(cl1), z2d ) 173 z2d(1,:) = str_ldf(: ) * rc_ggram ! (conversion in Gg)190 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 174 191 DO ji = 1, jpi 175 192 z2d(ji,:) = z2d(1,:) … … 177 194 cl1 = 'sopstldf' 178 195 CALL iom_put( TRIM(cl1), z2d ) 179 ENDIF 196 IF( ln_subbas ) THEN 197 DO jn=2,nptr 198 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 199 DO ji = 1, jpi 200 z2d(ji,:) = z2d(1,:) 201 ENDDO 202 cl1 = TRIM('sophtldf_'//clsubb(jn)) 203 CALL iom_put( cl1, z2d ) 204 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 205 DO ji = 1, jpi 206 z2d(ji,:) = z2d(1,:) 207 ENDDO 208 cl1 = TRIM('sopstldf_'//clsubb(jn)) 209 CALL iom_put( cl1, z2d ) 210 ENDDO 211 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 180 279 ! 181 280 ENDIF … … 256 355 ! Initialise arrays to zero because diatpr is called before they are first calculated 257 356 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 258 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp 259 htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 357 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 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 260 361 ! 261 362 ENDIF … … 263 364 END SUBROUTINE dia_ptr_init 264 365 366 SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva ) 367 !!---------------------------------------------------------------------- 368 !! *** ROUTINE dia_ptr_ohst_components *** 369 !!---------------------------------------------------------------------- 370 !! Wrapper for heat and salt transport calculations to calculate them for each basin 371 !! Called from all advection and/or diffusion routines 372 !!---------------------------------------------------------------------- 373 INTEGER , INTENT(in ) :: ktra ! tracer index 374 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 375 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 376 INTEGER :: jn ! 377 378 379 IF( cptr == 'adv' ) THEN 380 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 381 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pva(:,:,:) ) 382 ENDIF 383 IF( cptr == 'ldf' ) THEN 384 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 385 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 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 395 ! 396 IF( ln_subbas ) THEN 397 ! 398 IF( cptr == 'adv' ) THEN 399 IF( ktra == jp_tem ) THEN 400 DO jn = 2, nptr 401 htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 402 END DO 403 ENDIF 404 IF( ktra == jp_sal ) THEN 405 DO jn = 2, nptr 406 str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 407 END DO 408 ENDIF 409 ENDIF 410 IF( cptr == 'ldf' ) THEN 411 IF( ktra == jp_tem ) THEN 412 DO jn = 2, nptr 413 htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 414 END DO 415 ENDIF 416 IF( ktra == jp_sal ) THEN 417 DO jn = 2, nptr 418 str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 419 END DO 420 ENDIF 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 446 ! 447 ENDIF 448 449 END SUBROUTINE 450 265 451 266 452 FUNCTION dia_ptr_alloc() … … 274 460 ! 275 461 ALLOCATE( btmsk(jpi,jpj,nptr) , & 276 & htr_adv(jpj) , str_adv(jpj) , & 277 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 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) , & 465 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 278 466 ! 279 467 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6498 r6731 323 323 CALL iom_put( "hdiv", hdivn ) ! Horizontal divergence 324 324 ! 325 IF( iom_use("u_masstr") .OR. iom_use("u_ heattr") .OR. iom_use("u_salttr") ) THEN325 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 326 326 z3d(:,:,jpk) = 0.e0 327 z2d(:,:) = 0.e0 327 328 DO jk = 1, jpkm1 328 329 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 330 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 329 331 END DO 330 332 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 333 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 331 334 ENDIF 332 335 … … 391 394 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 392 395 ENDIF 396 397 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 393 398 ! 394 399 CALL wrk_dealloc( jpi , jpj , z2d ) -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r6498 r6731 228 228 ! automatic definitions of some of the xml attributs 229 229 CALL set_xmlatt 230 231 CALL set_1point 230 232 231 233 ! end file definition … … 1576 1578 zz=REAL(narea,wp) 1577 1579 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1578 1580 1579 1581 END SUBROUTINE set_scalar 1582 1583 SUBROUTINE set_1point 1584 !!---------------------------------------------------------------------- 1585 !! *** ROUTINE set_1point *** 1586 !! 1587 !! ** Purpose : define zoom grid for scalar fields 1588 !! 1589 !!---------------------------------------------------------------------- 1590 REAL(wp), DIMENSION(1) :: zz = 1. 1591 INTEGER :: ix, iy 1592 !!---------------------------------------------------------------------- 1593 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! Nearest point to north pole should be ocean 1594 CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 1595 1596 END SUBROUTINE set_1point 1580 1597 1581 1598 -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6700 r6731 1719 1719 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1720 1720 #endif 1721 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1721 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1) ) ! liquid precipitation 1722 CALL iom_put( 'rain_ao_cea' , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1) ) ! liquid precipitation 1722 1723 IF( iom_use('hflx_rain_cea') ) & 1723 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip.1724 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1)) ! heat flux from liq. precip. 1724 1725 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1725 1726 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1726 1727 IF( iom_use('evap_ao_cea' ) ) & 1727 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average)1728 CALL iom_put( 'evap_ao_cea' , ztmp * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1728 1729 IF( iom_use('hflx_evap_cea') ) & 1729 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average)1730 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from from evap (cell average) 1730 1731 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1731 1732 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1789 1790 ! runoffs and calving (put in emp_tot) 1790 1791 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1792 IF( iom_use('hflx_rnf_cea') ) & 1793 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 1791 1794 IF( srcv(jpr_cal)%laction ) THEN 1792 1795 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) … … 1806 1809 ENDIF 1807 1810 1808 CALL iom_put( 'snowpre' , sprecip 1811 CALL iom_put( 'snowpre' , sprecip * tmask(:,:,1) ) ! Snow 1809 1812 IF( iom_use('snow_ao_cea') ) & 1810 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) 1813 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) * tmask(:,:,1) ) ! Snow over ice-free ocean (cell average) 1811 1814 IF( iom_use('snow_ai_cea') ) & 1812 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) 1815 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) * tmask(:,:,1) ) ! Snow over sea-ice (cell average) 1813 1816 #endif 1814 1817 -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r6498 r6731 279 279 END IF 280 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 281 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 282 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 283 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 284 ENDIF 281 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 285 282 ! 286 283 END DO -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r6487 r6731 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 * u_eiv(:,:,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 zztmp = 0.5 * r au0 * rcp183 zztmp = 0.5 * rcp 164 184 z2d(:,:) = 0.e0 165 185 DO jk = 1, jpkm1 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 * v_eiv(:,:,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 * r au0 * rcp206 zztmp = 0.5 * rcp 179 207 z2d(:,:) = 0.e0 180 208 DO jk = 1, jpkm1 181 209 DO jj = 2, jpjm1 182 210 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) 211 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 185 212 END DO 186 213 END DO … … 190 217 ENDIF 191 218 END IF 219 ! 220 IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 221 z3d(:,:,:) = 0._wp 222 DO jk = 1, jpkm1 223 DO jj = 2, jpjm1 224 DO ji = fs_2, fs_jpim1 ! vector opt. 225 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 226 & * e1v(ji,jj) * fse3v(ji,jj,jk) 227 END DO 228 END DO 229 END DO 230 CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 231 z3d(:,:,:) = 0._wp 232 DO jk = 1, jpkm1 233 DO jj = 2, jpjm1 234 DO ji = fs_2, fs_jpim1 ! vector opt. 235 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 236 & * e1v(ji,jj) * fse3v(ji,jj,jk) 237 END DO 238 END DO 239 END DO 240 CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 241 ENDIF 192 242 # endif 193 ! 243 194 244 # if defined key_diaeiv 195 245 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 246 IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 196 247 # else 197 248 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r6486 r6731 219 219 END IF 220 220 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 221 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 222 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 223 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 224 ENDIF 221 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 225 222 226 223 ! II. Vertical advective fluxes -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r6486 r6731 200 200 201 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 202 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 203 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 204 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 205 ENDIF 202 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 206 203 207 204 ! II. Vertical advective fluxes -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r6486 r6731 355 355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 356 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 357 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 358 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 359 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 360 ENDIF 357 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 361 358 ! 362 359 END DO -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6487 r6731 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 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 90 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 88 91 !!---------------------------------------------------------------------- 89 92 ! … … 98 101 ! 99 102 l_trd = .FALSE. 103 l_trans = .FALSE. 100 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. 101 106 ENDIF 102 107 ! 103 IF( l_trd ) THEN108 IF( l_trd .OR. l_trans ) THEN 104 109 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 105 110 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 111 CALL wrk_alloc( jpi, jpj, z2d ) 112 ENDIF 113 ! 114 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 115 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 116 zptry(:,:,:) = 0._wp 106 117 ENDIF 107 118 ! … … 188 199 189 200 ! ! trend diagnostics (contribution of upstream fluxes) 190 IF( l_trd ) THEN201 IF( l_trd .OR. l_trans ) THEN 191 202 ! store intermediate advective trends 192 203 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 193 204 END IF 194 205 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 195 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 196 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 197 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 198 ENDIF 206 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 199 207 200 208 ! 3. antidiffusive flux : high order minus low order … … 254 262 255 263 ! ! trend diagnostics (contribution of upstream fluxes) 256 IF( l_trd ) THEN264 IF( l_trd .OR. l_trans ) THEN 257 265 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 258 266 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 259 267 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 260 261 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 262 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 263 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) ) 264 274 END IF 265 ! ! "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) 266 300 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 267 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)268 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)301 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 302 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 269 303 ENDIF 270 304 ! 271 305 END DO 272 306 ! 273 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 274 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 312 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 275 313 ! 276 314 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') … … 319 357 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 320 358 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 359 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 321 360 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 322 361 !!---------------------------------------------------------------------- … … 340 379 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 341 380 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 381 ENDIF 382 ! 383 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 384 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 385 zptry(:,:,:) = 0._wp 342 386 ENDIF 343 387 ! … … 430 474 END IF 431 475 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 432 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 433 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 434 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 435 ENDIF 476 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 436 477 437 478 ! 3. antidiffusive flux : high order minus low order … … 557 598 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 558 599 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 559 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)560 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)600 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 601 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 561 602 ENDIF 562 603 ! … … 567 608 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 568 609 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 610 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 569 611 ! 570 612 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd_zts') -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r6486 r6731 177 177 END IF 178 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 ENDIF 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 183 180 184 181 ! TVD scheme for the vertical direction -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r6486 r6731 173 173 ! 174 174 ! "zonal" mean lateral diffusive heat and salt transport 175 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 176 IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 177 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 178 ENDIF 175 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 179 176 ! ! =========== 180 177 END DO ! tracer loop -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r6486 r6731 247 247 ! ! =============== 248 248 ! "Poleward" diffusive heat or salt transport 249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 250 ! note sign is reversed to give down-gradient diffusive transports (#1043) 251 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 252 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 253 ENDIF 249 ! note sign is reversed to give down-gradient diffusive transports (#1043) 250 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 254 251 255 252 ! ! ************ ! ! =============== -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6486 r6731 235 235 ! 236 236 ! "Poleward" diffusive heat or salt transports (T-S case only) 237 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN238 237 ! note sign is reversed to give down-gradient diffusive transports (#1043) 239 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 240 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 241 ENDIF 238 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 242 239 243 240 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r6486 r6731 386 386 ! 387 387 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 389 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 390 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 391 ENDIF 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 392 389 393 390 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r6486 r6731 154 154 ! 155 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 159 ENDIF 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 160 157 ! ! ================== 161 158 END DO ! end of tracer loop
Note: See TracChangeset
for help on using the changeset viewer.