Changeset 6652
- Timestamp:
- 2016-06-01T17:06:23+02:00 (8 years ago)
- Location:
- branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
-
DIA/diaptr.F90 (modified) (8 diffs)
-
TRA/traadv_eiv.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6433 r6652 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 !: Heat TRansports (adv, diff, Bolus.) 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv !: 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 #ifdef key_diaeiv 215 IF(lk_traldf_eiv) THEN 216 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 217 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 218 DO ji = 1, jpi 219 z2d(ji,:) = z2d(1,:) 220 ENDDO 221 cl1 = 'sophteiv' 222 CALL iom_put( TRIM(cl1), z2d ) 223 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 224 DO ji = 1, jpi 225 z2d(ji,:) = z2d(1,:) 226 ENDDO 227 cl1 = 'sopsteiv' 228 CALL iom_put( TRIM(cl1), z2d ) 229 IF( ln_subbas ) THEN 230 DO jn=2,nptr 231 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 232 DO ji = 1, jpi 233 z2d(ji,:) = z2d(1,:) 234 ENDDO 235 cl1 = TRIM('sophteiv_'//clsubb(jn)) 236 CALL iom_put( cl1, z2d ) 237 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 238 DO ji = 1, jpi 239 z2d(ji,:) = z2d(1,:) 240 ENDDO 241 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 242 CALL iom_put( cl1, z2d ) 243 ENDDO 244 ENDIF 245 ENDIF 246 ENDIF 247 #endif 214 248 ! 215 249 ENDIF … … 292 326 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 293 327 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 328 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 294 329 ! 295 330 ENDIF … … 305 340 !!---------------------------------------------------------------------- 306 341 INTEGER , INTENT(in ) :: ktra ! tracer index 307 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 342 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 308 343 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 309 344 INTEGER :: jn ! … … 317 352 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 318 353 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 354 ENDIF 355 IF( cptr == 'eiv' ) THEN 356 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 357 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 319 358 ENDIF 320 359 ! … … 345 384 ENDIF 346 385 ENDIF 386 IF( cptr == 'eiv' ) THEN 387 IF( ktra == jp_tem ) THEN 388 DO jn = 2, nptr 389 htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 390 END DO 391 ENDIF 392 IF( ktra == jp_sal ) THEN 393 DO jn = 2, nptr 394 str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 395 END DO 396 ENDIF 397 ENDIF 347 398 ! 348 399 ENDIF … … 362 413 ALLOCATE( btmsk(jpi,jpj,nptr) , & 363 414 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 415 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 364 416 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 365 417 ! -
branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r6427 r6652 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 ) … … 190 193 ENDIF 191 194 END IF 195 ! 196 IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 197 z3d(:,:,:) = 0._wp 198 DO jk = 1, jpkm1 199 DO jj = 2, jpjm1 200 DO ji = fs_2, fs_jpim1 ! vector opt. 201 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 202 & * e1v(ji,jj) * fse3v(ji,jj,jk) 203 END DO 204 END DO 205 END DO 206 CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 207 z3d(:,:,:) = 0._wp 208 DO jk = 1, jpkm1 209 DO jj = 2, jpjm1 210 DO ji = fs_2, fs_jpim1 ! vector opt. 211 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 212 & * e1v(ji,jj) * fse3v(ji,jj,jk) 213 END DO 214 END DO 215 END DO 216 CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 217 ENDIF 192 218 # endif 193 ! 219 194 220 # if defined key_diaeiv 195 221 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 222 IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 196 223 # else 197 224 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
Note: See TracChangeset
for help on using the changeset viewer.
