Changeset 6731 for branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
- Timestamp:
- 2016-06-22T13:43:26+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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))
Note: See TracChangeset
for help on using the changeset viewer.
