- Timestamp:
- 2016-04-08T18:11:53+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6462 r6463 38 38 PUBLIC dia_ptr_init ! call in step module 39 39 PUBLIC dia_ptr ! call in step module 40 PUBLIC dia_ptr_ohst_components ! called from tra_ldf/tra_adv routines 40 41 41 42 ! !!** 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.)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.) 44 45 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 ) 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 179 213 ENDIF 180 214 ! … … 256 290 ! Initialise arrays to zero because diatpr is called before they are first calculated 257 291 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 258 htr_adv(: ) = 0._wp ; str_adv(:) = 0._wp259 htr_ldf(: ) = 0._wp ; str_ldf(:) = 0._wp292 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 293 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 260 294 ! 261 295 ENDIF … … 263 297 END SUBROUTINE dia_ptr_init 264 298 299 SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva ) 300 !!---------------------------------------------------------------------- 301 !! *** ROUTINE dia_ptr_ohst_components *** 302 !!---------------------------------------------------------------------- 303 !! Wrapper for heat and salt transport calculations to calculate them for each basin 304 !! Called from all advection and/or diffusion routines 305 !!---------------------------------------------------------------------- 306 INTEGER , INTENT(in ) :: ktra ! tracer index 307 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 308 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 309 INTEGER :: jn ! 310 311 312 IF( cptr == 'adv' ) THEN 313 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 314 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pva(:,:,:) ) 315 ENDIF 316 IF( cptr == 'ldf' ) THEN 317 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 318 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 319 ENDIF 320 ! 321 IF( ln_subbas ) THEN 322 ! 323 IF( cptr == 'adv' ) THEN 324 IF( ktra == jp_tem ) THEN 325 DO jn = 2, nptr 326 htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 327 END DO 328 ENDIF 329 IF( ktra == jp_sal ) THEN 330 DO jn = 2, nptr 331 str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 332 END DO 333 ENDIF 334 ENDIF 335 IF( cptr == 'ldf' ) THEN 336 IF( ktra == jp_tem ) THEN 337 DO jn = 2, nptr 338 htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 339 END DO 340 ENDIF 341 IF( ktra == jp_sal ) THEN 342 DO jn = 2, nptr 343 str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 344 END DO 345 ENDIF 346 ENDIF 347 ! 348 ENDIF 349 350 END SUBROUTINE 351 265 352 266 353 FUNCTION dia_ptr_alloc() … … 274 361 ! 275 362 ALLOCATE( btmsk(jpi,jpj,nptr) , & 276 & htr_adv(jpj ) , str_adv(jpj) , &277 & htr_ldf(jpj ) , str_ldf(jpj) , STAT=ierr(1) )363 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 364 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 278 365 ! 279 366 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6462 r6463 86 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 87 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 88 89 !!---------------------------------------------------------------------- 89 90 ! … … 104 105 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 105 106 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 107 ENDIF 108 ! 109 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 110 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 111 zptry(:,:,:) = 0._wp 106 112 ENDIF 107 113 ! … … 193 199 END IF 194 200 ! ! "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 201 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 199 202 200 203 ! 3. antidiffusive flux : high order minus low order … … 265 268 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 266 269 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(:)270 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 271 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 269 272 ENDIF 270 273 ! … … 273 276 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 274 277 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 278 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 275 279 ! 276 280 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') … … 319 323 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 320 324 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 325 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 321 326 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 322 327 !!---------------------------------------------------------------------- … … 340 345 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 341 346 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 347 ENDIF 348 ! 349 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 350 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 351 zptry(:,:,:) = 0._wp 342 352 ENDIF 343 353 ! … … 430 440 END IF 431 441 ! ! "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 442 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 436 443 437 444 ! 3. antidiffusive flux : high order minus low order … … 557 564 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 558 565 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(:)566 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 567 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 561 568 ENDIF 562 569 ! … … 567 574 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 568 575 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 576 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 569 577 ! 570 578 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd_zts') -
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r6462 r6463 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_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r6462 r6463 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.