- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r9816 r9817 9 9 !! 3.3 ! 2010-10 (G. Madec) dynamical allocation 10 10 !! 3.6 ! 2014-12 (C. Ethe) use of IOM 11 !! 3.6 ! 2016-06 (T. Graham) Addition of diagnostics for CMIP6 11 12 !!---------------------------------------------------------------------- 12 13 … … 21 22 USE dom_oce ! ocean space and time domain 22 23 USE phycst ! physical constants 24 USE ldftra_oce 23 25 ! 24 26 USE iom ! IOM library … … 38 40 PUBLIC dia_ptr_init ! call in step module 39 41 PUBLIC dia_ptr ! call in step module 42 PUBLIC dia_ptr_ohst_components ! called from tra_ldf/tra_adv routines 40 43 41 44 ! !!** 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 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv, htr_vt !: Heat TRansports (adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv, str_vs !: Salt TRansports (adv, diff, Bolus.) 47 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_ove, str_ove !: heat Salt TRansports ( overturn.) 48 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_btr, str_btr !: heat Salt TRansports ( barotropic ) 45 49 46 50 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 47 51 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 48 INTEGER 52 INTEGER, PUBLIC :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 49 53 50 54 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 77 81 ! 78 82 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 REAL(wp) :: z v, zsfc ! local scalar83 REAL(wp) :: zsfc,zvfc ! local scalar 80 84 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 81 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 82 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 83 87 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 84 CHARACTER( len = 10 ) :: cl1 88 REAL(wp), DIMENSION(jpj) :: vsum ! 1D workspace 89 REAL(wp), DIMENSION(jpj,jpts) :: tssum ! 1D workspace 90 91 ! 92 !overturning calculation 93 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 94 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace 96 97 98 CHARACTER( len = 12 ) :: cl1 85 99 !!---------------------------------------------------------------------- 86 100 ! … … 88 102 89 103 ! 104 z3d(:,:,:) = 0._wp 90 105 IF( PRESENT( pvtr ) ) THEN 91 106 IF( iom_use("zomsfglo") ) THEN ! effective MSF 92 107 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport 93 DO jk = 2, jpkm194 z3d(1,:,jk) = z3d(1,:,jk -1) +z3d(1,:,jk) ! effective j-Stream-Function (MSF)108 DO jk = jpkm1,1,-1 !Integrate from bottom up to get 109 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) 95 110 END DO 96 111 DO ji = 1, jpi … … 100 115 CALL iom_put( cl1, z3d * rc_sv ) 101 116 DO jn = 2, nptr ! by sub-basins 102 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn) *btm30(:,:))103 DO jk = 2, jpkm1104 z3d(1,:,jk) = z3d(1,:,jk -1) +z3d(1,:,jk) ! effective j-Stream-Function (MSF)117 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn) ) 118 DO jk = jpkm1,1,-1 119 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) 105 120 END DO 106 121 DO ji = 1, jpi … … 111 126 END DO 112 127 ENDIF 128 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 129 ! define fields multiplied by scalar 130 zmask(:,:,:) = 0._wp 131 zts(:,:,:,:) = 0._wp 132 zvn(:,:,:) = 0._wp 133 DO jk = 1, jpkm1 134 DO jj = 1, jpjm1 135 DO ji = 1, jpi 136 zvfc = e1v(ji,jj) * fse3v(ji,jj,jk) 137 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc 138 zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc !Tracers averaged onto V grid 139 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 140 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc 141 ENDDO 142 ENDDO 143 ENDDO 144 ENDIF 145 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 146 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 147 r1_sjk(:,:,1) = 0._wp 148 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 149 150 ! i-mean T and S, j-Stream-Function, global 151 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 152 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 153 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 154 155 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 156 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 157 158 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 159 DO ji = 1, jpi 160 z2d(ji,:) = z2d(1,:) 161 ENDDO 162 cl1 = 'sophtove' 163 CALL iom_put( TRIM(cl1), z2d ) 164 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 165 DO ji = 1, jpi 166 z2d(ji,:) = z2d(1,:) 167 ENDDO 168 cl1 = 'sopstove' 169 CALL iom_put( TRIM(cl1), z2d ) 170 IF( ln_subbas ) THEN 171 DO jn = 2, nptr 172 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 173 r1_sjk(:,:,jn) = 0._wp 174 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 175 176 ! i-mean T and S, j-Stream-Function, basin 177 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 178 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 179 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 180 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 181 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 182 183 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 184 DO ji = 1, jpi 185 z2d(ji,:) = z2d(1,:) 186 ENDDO 187 cl1 = TRIM('sophtove_'//clsubb(jn)) 188 CALL iom_put( cl1, z2d ) 189 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 190 DO ji = 1, jpi 191 z2d(ji,:) = z2d(1,:) 192 ENDDO 193 cl1 = TRIM('sopstove_'//clsubb(jn)) 194 CALL iom_put( cl1, z2d ) 195 END DO 196 ENDIF 197 ENDIF 198 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 199 ! Calculate barotropic heat and salt transport here 200 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 201 r1_sjk(:,1,1) = 0._wp 202 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 203 204 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 205 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 206 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 207 htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 208 str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 209 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 210 DO ji = 2, jpi 211 z2d(ji,:) = z2d(1,:) 212 ENDDO 213 cl1 = 'sophtbtr' 214 CALL iom_put( TRIM(cl1), z2d ) 215 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 216 DO ji = 2, jpi 217 z2d(ji,:) = z2d(1,:) 218 ENDDO 219 cl1 = 'sopstbtr' 220 CALL iom_put( TRIM(cl1), z2d ) 221 IF( ln_subbas ) THEN 222 DO jn = 2, nptr 223 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 224 r1_sjk(:,1,jn) = 0._wp 225 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 226 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 227 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 228 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 229 htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 230 str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 231 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 232 DO ji = 1, jpi 233 z2d(ji,:) = z2d(1,:) 234 ENDDO 235 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 236 CALL iom_put( cl1, z2d ) 237 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 238 DO ji = 1, jpi 239 z2d(ji,:) = z2d(1,:) 240 ENDDO 241 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 242 CALL iom_put( cl1, z2d ) 243 ENDDO 244 ENDIF !ln_subbas 245 ENDIF !iom_use("sopstbtr....) 113 246 ! 114 247 ELSE … … 150 283 ! ! Advective and diffusive heat and salt transport 151 284 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 152 z2d(1,:) = htr_adv(: ) * rc_pwatt ! (conversion in PW)285 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 153 286 DO ji = 1, jpi 154 287 z2d(ji,:) = z2d(1,:) … … 156 289 cl1 = 'sophtadv' 157 290 CALL iom_put( TRIM(cl1), z2d ) 158 z2d(1,:) = str_adv(: ) * rc_ggram ! (conversion in Gg)291 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 159 292 DO ji = 1, jpi 160 293 z2d(ji,:) = z2d(1,:) … … 162 295 cl1 = 'sopstadv' 163 296 CALL iom_put( TRIM(cl1), z2d ) 297 IF( ln_subbas ) THEN 298 DO jn=2,nptr 299 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 300 DO ji = 1, jpi 301 z2d(ji,:) = z2d(1,:) 302 ENDDO 303 cl1 = TRIM('sophtadv_'//clsubb(jn)) 304 CALL iom_put( cl1, z2d ) 305 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 306 DO ji = 1, jpi 307 z2d(ji,:) = z2d(1,:) 308 ENDDO 309 cl1 = TRIM('sopstadv_'//clsubb(jn)) 310 CALL iom_put( cl1, z2d ) 311 ENDDO 312 ENDIF 164 313 ENDIF 165 314 ! 166 315 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 167 z2d(1,:) = htr_ldf(: ) * rc_pwatt ! (conversion in PW)316 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 168 317 DO ji = 1, jpi 169 318 z2d(ji,:) = z2d(1,:) … … 171 320 cl1 = 'sophtldf' 172 321 CALL iom_put( TRIM(cl1), z2d ) 173 z2d(1,:) = str_ldf(: ) * rc_ggram ! (conversion in Gg)322 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 174 323 DO ji = 1, jpi 175 324 z2d(ji,:) = z2d(1,:) … … 177 326 cl1 = 'sopstldf' 178 327 CALL iom_put( TRIM(cl1), z2d ) 179 ENDIF 328 IF( ln_subbas ) THEN 329 DO jn=2,nptr 330 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 331 DO ji = 1, jpi 332 z2d(ji,:) = z2d(1,:) 333 ENDDO 334 cl1 = TRIM('sophtldf_'//clsubb(jn)) 335 CALL iom_put( cl1, z2d ) 336 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 337 DO ji = 1, jpi 338 z2d(ji,:) = z2d(1,:) 339 ENDDO 340 cl1 = TRIM('sopstldf_'//clsubb(jn)) 341 CALL iom_put( cl1, z2d ) 342 ENDDO 343 ENDIF 344 ENDIF 345 346 IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN 347 z2d(1,:) = htr_vt(:,1) * rc_pwatt ! (conversion in PW) 348 DO ji = 1, jpi 349 z2d(ji,:) = z2d(1,:) 350 ENDDO 351 cl1 = 'sopht_vt' 352 CALL iom_put( TRIM(cl1), z2d ) 353 z2d(1,:) = str_vs(:,1) * rc_ggram ! (conversion in Gg) 354 DO ji = 1, jpi 355 z2d(ji,:) = z2d(1,:) 356 ENDDO 357 cl1 = 'sopst_vs' 358 CALL iom_put( TRIM(cl1), z2d ) 359 IF( ln_subbas ) THEN 360 DO jn=2,nptr 361 z2d(1,:) = htr_vt(:,jn) * rc_pwatt ! (conversion in PW) 362 DO ji = 1, jpi 363 z2d(ji,:) = z2d(1,:) 364 ENDDO 365 cl1 = TRIM('sopht_vt_'//clsubb(jn)) 366 CALL iom_put( cl1, z2d ) 367 z2d(1,:) = str_vs(:,jn) * rc_ggram ! (conversion in Gg) 368 DO ji = 1, jpi 369 z2d(ji,:) = z2d(1,:) 370 ENDDO 371 cl1 = TRIM('sopst_vs_'//clsubb(jn)) 372 CALL iom_put( cl1, z2d ) 373 ENDDO 374 ENDIF 375 ENDIF 376 377 #ifdef key_diaeiv 378 IF(lk_traldf_eiv) THEN 379 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 380 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 381 DO ji = 1, jpi 382 z2d(ji,:) = z2d(1,:) 383 ENDDO 384 cl1 = 'sophteiv' 385 CALL iom_put( TRIM(cl1), z2d ) 386 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 387 DO ji = 1, jpi 388 z2d(ji,:) = z2d(1,:) 389 ENDDO 390 cl1 = 'sopsteiv' 391 CALL iom_put( TRIM(cl1), z2d ) 392 IF( ln_subbas ) THEN 393 DO jn=2,nptr 394 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 395 DO ji = 1, jpi 396 z2d(ji,:) = z2d(1,:) 397 ENDDO 398 cl1 = TRIM('sophteiv_'//clsubb(jn)) 399 CALL iom_put( cl1, z2d ) 400 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 401 DO ji = 1, jpi 402 z2d(ji,:) = z2d(1,:) 403 ENDDO 404 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 405 CALL iom_put( cl1, z2d ) 406 ENDDO 407 ENDIF 408 ENDIF 409 IF( iom_use("zomsfeivglo") ) THEN 410 z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:) ) ! zonal cumulative effective transport 411 DO jk = jpkm1,1,-1 412 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) 413 END DO 414 DO ji = 1, jpi 415 z3d(ji,:,:) = z3d(1,:,:) 416 ENDDO 417 cl1 = TRIM('zomsfeiv'//clsubb(1) ) 418 CALL iom_put( cl1, z3d * rc_sv ) 419 IF( ln_subbas ) THEN 420 DO jn = 2, nptr ! by sub-basins 421 z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:), btmsk(:,:,jn) ) 422 DO jk = jpkm1,1,-1 423 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) 424 END DO 425 DO ji = 1, jpi 426 z3d(ji,:,:) = z3d(1,:,:) 427 ENDDO 428 cl1 = TRIM('zomsfeiv'//clsubb(jn) ) 429 CALL iom_put( cl1, z3d * rc_sv ) 430 END DO 431 ENDIF 432 ENDIF 433 ENDIF 434 #endif 180 435 ! 181 436 ENDIF … … 256 511 ! Initialise arrays to zero because diatpr is called before they are first calculated 257 512 ! 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 513 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 514 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 515 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 516 htr_vt(:,:) = 0._wp ; str_vs(:,:) = 0._wp 517 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 518 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 260 519 ! 261 520 ENDIF … … 263 522 END SUBROUTINE dia_ptr_init 264 523 524 SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva ) 525 !!---------------------------------------------------------------------- 526 !! *** ROUTINE dia_ptr_ohst_components *** 527 !!---------------------------------------------------------------------- 528 !! Wrapper for heat and salt transport calculations to calculate them for each basin 529 !! Called from all advection and/or diffusion routines 530 !!---------------------------------------------------------------------- 531 INTEGER , INTENT(in ) :: ktra ! tracer index 532 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 533 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 534 INTEGER :: jn ! 535 536 IF( cptr == 'adv' ) THEN 537 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 538 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pva(:,:,:) ) 539 ENDIF 540 IF( cptr == 'ldf' ) THEN 541 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 542 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 543 ENDIF 544 IF( cptr == 'eiv' ) THEN 545 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 546 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 547 ENDIF 548 IF( cptr == 'vts' ) THEN 549 IF( ktra == jp_tem ) htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 550 IF( ktra == jp_sal ) str_vs(:,1) = ptr_sj( pva(:,:,:) ) 551 ENDIF 552 ! 553 IF( ln_subbas ) THEN 554 ! 555 IF( cptr == 'adv' ) THEN 556 IF( ktra == jp_tem ) THEN 557 DO jn = 2, nptr 558 htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 559 END DO 560 ENDIF 561 IF( ktra == jp_sal ) THEN 562 DO jn = 2, nptr 563 str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 564 END DO 565 ENDIF 566 ENDIF 567 IF( cptr == 'ldf' ) THEN 568 IF( ktra == jp_tem ) THEN 569 DO jn = 2, nptr 570 htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 571 END DO 572 ENDIF 573 IF( ktra == jp_sal ) THEN 574 DO jn = 2, nptr 575 str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 576 END DO 577 ENDIF 578 ENDIF 579 IF( cptr == 'eiv' ) THEN 580 IF( ktra == jp_tem ) THEN 581 DO jn = 2, nptr 582 htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 583 END DO 584 ENDIF 585 IF( ktra == jp_sal ) THEN 586 DO jn = 2, nptr 587 str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 588 END DO 589 ENDIF 590 ENDIF 591 IF( cptr == 'vts' ) THEN 592 IF( ktra == jp_tem ) THEN 593 DO jn = 2, nptr 594 htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 595 END DO 596 ENDIF 597 IF( ktra == jp_sal ) THEN 598 DO jn = 2, nptr 599 str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 600 END DO 601 ENDIF 602 ENDIF 603 ! 604 ENDIF 605 END SUBROUTINE dia_ptr_ohst_components 606 265 607 266 608 FUNCTION dia_ptr_alloc() … … 273 615 ierr(:) = 0 274 616 ! 275 ALLOCATE( btmsk(jpi,jpj,nptr) , & 276 & htr_adv(jpj) , str_adv(jpj) , & 277 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 617 ALLOCATE( btmsk(jpi,jpj,nptr) , & 618 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 619 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 620 & htr_vt(jpj,nptr) , str_vs(jpj,nptr) , & 621 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 622 & htr_btr(jpj,nptr) , str_btr(jpj,nptr) , & 623 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 278 624 ! 279 625 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) … … 402 748 #endif 403 749 !!-------------------------------------------------------------------- 404 750 ! 405 751 p_fval => p_fval2d 406 752 … … 434 780 #endif 435 781 ! 782 436 783 END FUNCTION ptr_sjk 437 784
Note: See TracChangeset
for help on using the changeset viewer.
