- Timestamp:
- 2016-08-17T11:13:03+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/v3_6_extra_CMIP6_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6672 r6871 44 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv, htr_vt !: Heat TRansports (adv, diff, Bolus.) 45 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv, str_vs !: Salt TRansports (adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_ove, str_ove !: heat Salt TRansports ( overturn.) 47 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_btr, str_btr !: heat Salt TRansports ( barotropic ) 46 48 47 49 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) … … 78 80 ! 79 81 INTEGER :: ji, jj, jk, jn ! dummy loop indices 80 REAL(wp) :: z v, zsfc ! local scalar82 REAL(wp) :: zsfc,zvfc ! local scalar 81 83 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 82 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 83 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 84 86 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 87 ! 88 !overturning calculation 89 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 90 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace 92 93 85 94 CHARACTER( len = 12 ) :: cl1 86 95 !!---------------------------------------------------------------------- … … 112 121 END DO 113 122 ENDIF 123 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 124 ! define fields multiplied by scalar 125 zmask(:,:,:) = 0._wp 126 zts(:,:,:,:) = 0._wp 127 zvn(:,:,:) = 0._wp 128 DO jk = 1, jpkm1 129 DO jj = 1, jpjm1 130 DO ji = 1, jpi 131 zvfc = e1v(ji,jj) * fse3v(ji,jj,jk) 132 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc 133 zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj,jk,jp_tem)) * 0.5 * zvfc !Tracers averaged onto V grid 134 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj,jk,jp_sal)) * 0.5 * zvfc 135 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc 136 ENDDO 137 ENDDO 138 ENDDO 139 ENDIF 140 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 141 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 142 r1_sjk(:,:,1) = 0._wp 143 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 144 145 ! i-mean T and S, j-Stream-Function, global 146 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 147 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 148 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 149 150 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 151 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 152 153 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 154 DO ji = 1, jpi 155 z2d(ji,:) = z2d(1,:) 156 ENDDO 157 cl1 = 'sophtove' 158 CALL iom_put( TRIM(cl1), z2d ) 159 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 160 DO ji = 1, jpi 161 z2d(ji,:) = z2d(1,:) 162 ENDDO 163 cl1 = 'sopstove' 164 CALL iom_put( TRIM(cl1), z2d ) 165 IF( ln_subbas ) THEN 166 DO jn = 2, nptr 167 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 168 r1_sjk(:,:,jn) = 0._wp 169 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 170 171 ! i-mean T and S, j-Stream-Function, basin 172 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 173 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 174 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 175 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 176 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 177 178 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 179 DO ji = 1, jpi 180 z2d(ji,:) = z2d(1,:) 181 ENDDO 182 cl1 = TRIM('sophtove_'//clsubb(jn)) 183 CALL iom_put( cl1, z2d ) 184 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 185 DO ji = 1, jpi 186 z2d(ji,:) = z2d(1,:) 187 ENDDO 188 cl1 = TRIM('sopstove_'//clsubb(jn)) 189 CALL iom_put( cl1, z2d ) 190 END DO 191 ENDIF 192 ENDIF 193 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 194 ! Calculate barotropic heat and salt transport here 195 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 196 r1_sjk(:,1,1) = 0._wp 197 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 198 199 htr_btr(:,1) = ptr_sj( zvn(:,:,:)) * ptr_sj( zts(:,:,:,jp_tem) ) * r1_sjk(:,1,1) 200 str_btr(:,1) = ptr_sj( zvn(:,:,:)) * ptr_sj( zts(:,:,:,jp_sal) ) * r1_sjk(:,1,1) 201 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 202 DO ji = 1, jpi 203 z2d(ji,:) = z2d(1,:) 204 ENDDO 205 cl1 = 'sophtbtr' 206 CALL iom_put( TRIM(cl1), z2d ) 207 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 208 DO ji = 1, jpi 209 z2d(ji,:) = z2d(1,:) 210 ENDDO 211 cl1 = 'sopstbtr' 212 CALL iom_put( TRIM(cl1), z2d ) 213 IF( ln_subbas ) THEN 214 DO jn = 2, nptr 215 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 216 r1_sjk(:,1,jn) = 0._wp 217 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 218 htr_btr(:,jn) = ptr_sj( zvn(:,:,:)) * ptr_sj( zts(:,:,:,jp_tem) ) * r1_sjk(:,1,jn) 219 str_btr(:,jn) = ptr_sj( zvn(:,:,:)) * ptr_sj( zts(:,:,:,jp_sal) ) * r1_sjk(:,1,jn) 220 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 221 DO ji = 1, jpi 222 z2d(ji,:) = z2d(1,:) 223 ENDDO 224 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 225 CALL iom_put( cl1, z2d ) 226 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 227 DO ji = 1, jpi 228 z2d(ji,:) = z2d(1,:) 229 ENDDO 230 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 231 CALL iom_put( cl1, z2d ) 232 ENDDO 233 ENDIF !ln_subbas 234 ENDIF !iom_use("sopstbtr....) 114 235 ! 115 236 ELSE … … 355 476 ! Initialise arrays to zero because diatpr is called before they are first calculated 356 477 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 357 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 478 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 358 479 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 359 480 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 360 htr_vt(:,:) = 0._wp ; str_vs(:,:) = 0._wp 481 htr_vt(:,:) = 0._wp ; str_vs(:,:) = 0._wp 482 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 483 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 361 484 ! 362 485 ENDIF … … 376 499 INTEGER :: jn ! 377 500 378 379 501 IF( cptr == 'adv' ) THEN 380 502 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) … … 446 568 ! 447 569 ENDIF 448 449 END SUBROUTINE 570 END SUBROUTINE dia_ptr_ohst_components 450 571 451 572 … … 459 580 ierr(:) = 0 460 581 ! 461 ALLOCATE( btmsk(jpi,jpj,nptr) , &582 ALLOCATE( btmsk(jpi,jpj,nptr) , & 462 583 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 463 584 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 464 585 & htr_vt(jpj,nptr) , str_vs(jpj,nptr) , & 586 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 465 587 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 466 588 ! … … 590 712 #endif 591 713 !!-------------------------------------------------------------------- 592 714 ! 593 715 p_fval => p_fval2d 594 716 … … 622 744 #endif 623 745 ! 746 624 747 END FUNCTION ptr_sjk 625 748
Note: See TracChangeset
for help on using the changeset viewer.