- Timestamp:
- 2016-11-03T16:39:56+01:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 4 edited
-
diaar5.F90 (modified) (8 diffs)
-
diaprod.F90 (modified) (5 diffs)
-
diaptr.F90 (modified) (15 diffs)
-
diawri.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6793 r7179 24 24 USE phycst ! physical constant 25 25 USE in_out_manager ! I/O manager 26 USE zdfddm 27 USE zdf_oce 26 28 27 29 IMPLICIT NONE … … 42 44 !! * Substitutions 43 45 # include "domzgr_substitute.h90" 46 # include "zdfddm_substitute.h90" 44 47 !!---------------------------------------------------------------------- 45 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 75 78 INTEGER :: ji, jj, jk ! dummy loop arguments 76 79 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 80 REAL(wp) :: zaw, zbw, zrw 77 81 ! 78 82 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 83 REAL(wp), POINTER, DIMENSION(:,:) :: pe ! 2D workspace 79 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 80 85 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace … … 82 87 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') 83 88 84 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres )89 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres, pe ) 85 90 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 86 91 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) … … 95 100 CALL iom_put( 'voltot', zvol ) 96 101 CALL iom_put( 'sshtot', zvolssh / area_tot ) 102 CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 97 103 98 104 ! 105 IF( iom_use('sshthster') ) THEN 99 106 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 100 107 ztsn(:,:,:,jp_sal) = sn0(:,:,:) … … 116 123 END IF 117 124 END IF 125 ENDIF 118 126 ! 119 127 zarho = SUM( area(:,:) * zbotpres(:,:) ) … … 190 198 CALL iom_put( 'temptot', ztemp ) 191 199 CALL iom_put( 'saltot' , zsal ) 192 ! 193 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 200 201 IF( iom_use( 'tnpeo' )) THEN 202 ! Work done against stratification by vertical mixing 203 ! Exclude points where rn2 is negative as convection kicks in here and 204 ! work is not being done against stratification 205 pe(:,:) = 0._wp 206 IF( lk_zdfddm ) THEN 207 DO ji=1,jpi 208 DO jj=1,jpj 209 DO jk=1,jpk 210 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 211 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 212 ! 213 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 214 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 215 ! 216 pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 217 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 218 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 219 220 ENDDO 221 ENDDO 222 ENDDO 223 ELSE 224 DO ji=1,jpi 225 DO jj=1,jpj 226 DO jk=1,jpk 227 pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 228 ENDDO 229 ENDDO 230 ENDDO 231 ENDIF 232 CALL iom_put( 'tnpeo', pe ) 233 ENDIF 234 ! 235 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres, pe ) 194 236 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 195 237 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) … … 232 274 IF( lk_mpp ) CALL mpp_sum( vol0 ) 233 275 234 CALL iom_open ( 'sali_ref_clim_monthly', inum )235 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 )236 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 )237 CALL iom_close( inum )276 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 277 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 278 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 279 CALL iom_close( inum ) 238 280 239 281 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90
r6491 r7179 25 25 USE timing ! preformance summary 26 26 USE wrk_nemo ! working array 27 USE diaptr 27 28 28 29 IMPLICIT NONE … … 98 99 ENDIF 99 100 100 IF( iom_use("vt") ) THEN101 IF( iom_use("vt") .OR. iom_use("sopht_vt") ) THEN 101 102 z3d(:,:,:) = 0.e0 102 103 DO jk = 1, jpkm1 … … 108 109 END DO 109 110 CALL iom_put( "vt", z3d ) ! product of temperature and meridional velocity at V points 111 DO jk = 1, jpkm1 112 DO jj = 2, jpjm1 113 DO ji = fs_2, fs_jpim1 ! vector opt. 114 z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 115 END DO 116 END DO 117 END DO 118 IF(ln_diaptr) CALL dia_ptr_ohst_components( jp_tem, 'vts', z3d) 110 119 ENDIF 111 120 … … 139 148 ENDIF 140 149 141 IF( iom_use("vs") ) THEN150 IF( iom_use("vs") .OR. iom_use("sopst_vs") ) THEN 142 151 z3d(:,:,:) = 0.e0 143 152 DO jk = 1, jpkm1 … … 149 158 END DO 150 159 CALL iom_put( "vs", z3d ) ! product of salinity and meridional velocity at V points 160 DO jk = 1, jpkm1 161 DO jj = 2, jpjm1 162 DO ji = fs_2, fs_jpim1 ! vector opt. 163 z3d(ji,jj,jk) = z3d(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 164 END DO 165 END DO 166 END DO 167 IF(ln_diaptr) CALL dia_ptr_ohst_components( jp_sal, 'vts', z3d) 151 168 ENDIF 152 169 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6486 r7179 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 ! … … 111 125 END DO 112 126 ENDIF 127 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 128 ! define fields multiplied by scalar 129 zmask(:,:,:) = 0._wp 130 zts(:,:,:,:) = 0._wp 131 zvn(:,:,:) = 0._wp 132 DO jk = 1, jpkm1 133 DO jj = 1, jpjm1 134 DO ji = 1, jpi 135 zvfc = e1v(ji,jj) * fse3v(ji,jj,jk) 136 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc 137 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 138 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 139 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc 140 ENDDO 141 ENDDO 142 ENDDO 143 ENDIF 144 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 145 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 146 r1_sjk(:,:,1) = 0._wp 147 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 148 149 ! i-mean T and S, j-Stream-Function, global 150 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 151 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 152 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 153 154 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 155 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 156 157 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 158 DO ji = 1, jpi 159 z2d(ji,:) = z2d(1,:) 160 ENDDO 161 cl1 = 'sophtove' 162 CALL iom_put( TRIM(cl1), z2d ) 163 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 164 DO ji = 1, jpi 165 z2d(ji,:) = z2d(1,:) 166 ENDDO 167 cl1 = 'sopstove' 168 CALL iom_put( TRIM(cl1), z2d ) 169 IF( ln_subbas ) THEN 170 DO jn = 2, nptr 171 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 172 r1_sjk(:,:,jn) = 0._wp 173 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 174 175 ! i-mean T and S, j-Stream-Function, basin 176 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 177 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 178 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 179 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 180 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 181 182 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 183 DO ji = 1, jpi 184 z2d(ji,:) = z2d(1,:) 185 ENDDO 186 cl1 = TRIM('sophtove_'//clsubb(jn)) 187 CALL iom_put( cl1, z2d ) 188 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 189 DO ji = 1, jpi 190 z2d(ji,:) = z2d(1,:) 191 ENDDO 192 cl1 = TRIM('sopstove_'//clsubb(jn)) 193 CALL iom_put( cl1, z2d ) 194 END DO 195 ENDIF 196 ENDIF 197 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 198 ! Calculate barotropic heat and salt transport here 199 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 200 r1_sjk(:,1,1) = 0._wp 201 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 202 203 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 204 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 205 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 206 htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 207 str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 208 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 209 DO ji = 2, jpi 210 z2d(ji,:) = z2d(1,:) 211 ENDDO 212 cl1 = 'sophtbtr' 213 CALL iom_put( TRIM(cl1), z2d ) 214 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 215 DO ji = 2, jpi 216 z2d(ji,:) = z2d(1,:) 217 ENDDO 218 cl1 = 'sopstbtr' 219 CALL iom_put( TRIM(cl1), z2d ) 220 IF( ln_subbas ) THEN 221 DO jn = 2, nptr 222 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 223 r1_sjk(:,1,jn) = 0._wp 224 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 225 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 226 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 227 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 228 htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 229 str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 230 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 231 DO ji = 1, jpi 232 z2d(ji,:) = z2d(1,:) 233 ENDDO 234 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 235 CALL iom_put( cl1, z2d ) 236 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 237 DO ji = 1, jpi 238 z2d(ji,:) = z2d(1,:) 239 ENDDO 240 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 241 CALL iom_put( cl1, z2d ) 242 ENDDO 243 ENDIF !ln_subbas 244 ENDIF !iom_use("sopstbtr....) 113 245 ! 114 246 ELSE … … 150 282 ! ! Advective and diffusive heat and salt transport 151 283 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 152 z2d(1,:) = htr_adv(: ) * rc_pwatt ! (conversion in PW)284 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 153 285 DO ji = 1, jpi 154 286 z2d(ji,:) = z2d(1,:) … … 156 288 cl1 = 'sophtadv' 157 289 CALL iom_put( TRIM(cl1), z2d ) 158 z2d(1,:) = str_adv(: ) * rc_ggram ! (conversion in Gg)290 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 159 291 DO ji = 1, jpi 160 292 z2d(ji,:) = z2d(1,:) … … 162 294 cl1 = 'sopstadv' 163 295 CALL iom_put( TRIM(cl1), z2d ) 296 IF( ln_subbas ) THEN 297 DO jn=2,nptr 298 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 299 DO ji = 1, jpi 300 z2d(ji,:) = z2d(1,:) 301 ENDDO 302 cl1 = TRIM('sophtadv_'//clsubb(jn)) 303 CALL iom_put( cl1, z2d ) 304 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 305 DO ji = 1, jpi 306 z2d(ji,:) = z2d(1,:) 307 ENDDO 308 cl1 = TRIM('sopstadv_'//clsubb(jn)) 309 CALL iom_put( cl1, z2d ) 310 ENDDO 311 ENDIF 164 312 ENDIF 165 313 ! 166 314 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 167 z2d(1,:) = htr_ldf(: ) * rc_pwatt ! (conversion in PW)315 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 168 316 DO ji = 1, jpi 169 317 z2d(ji,:) = z2d(1,:) … … 171 319 cl1 = 'sophtldf' 172 320 CALL iom_put( TRIM(cl1), z2d ) 173 z2d(1,:) = str_ldf(: ) * rc_ggram ! (conversion in Gg)321 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 174 322 DO ji = 1, jpi 175 323 z2d(ji,:) = z2d(1,:) … … 177 325 cl1 = 'sopstldf' 178 326 CALL iom_put( TRIM(cl1), z2d ) 179 ENDIF 327 IF( ln_subbas ) THEN 328 DO jn=2,nptr 329 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 330 DO ji = 1, jpi 331 z2d(ji,:) = z2d(1,:) 332 ENDDO 333 cl1 = TRIM('sophtldf_'//clsubb(jn)) 334 CALL iom_put( cl1, z2d ) 335 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 336 DO ji = 1, jpi 337 z2d(ji,:) = z2d(1,:) 338 ENDDO 339 cl1 = TRIM('sopstldf_'//clsubb(jn)) 340 CALL iom_put( cl1, z2d ) 341 ENDDO 342 ENDIF 343 ENDIF 344 345 IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN 346 z2d(1,:) = htr_vt(:,1) * rc_pwatt ! (conversion in PW) 347 DO ji = 1, jpi 348 z2d(ji,:) = z2d(1,:) 349 ENDDO 350 cl1 = 'sopht_vt' 351 CALL iom_put( TRIM(cl1), z2d ) 352 z2d(1,:) = str_vs(:,1) * rc_ggram ! (conversion in Gg) 353 DO ji = 1, jpi 354 z2d(ji,:) = z2d(1,:) 355 ENDDO 356 cl1 = 'sopst_vs' 357 CALL iom_put( TRIM(cl1), z2d ) 358 IF( ln_subbas ) THEN 359 DO jn=2,nptr 360 z2d(1,:) = htr_vt(:,jn) * rc_pwatt ! (conversion in PW) 361 DO ji = 1, jpi 362 z2d(ji,:) = z2d(1,:) 363 ENDDO 364 cl1 = TRIM('sopht_vt_'//clsubb(jn)) 365 CALL iom_put( cl1, z2d ) 366 z2d(1,:) = str_vs(:,jn) * rc_ggram ! (conversion in Gg) 367 DO ji = 1, jpi 368 z2d(ji,:) = z2d(1,:) 369 ENDDO 370 cl1 = TRIM('sopst_vs_'//clsubb(jn)) 371 CALL iom_put( cl1, z2d ) 372 ENDDO 373 ENDIF 374 ENDIF 375 376 #ifdef key_diaeiv 377 IF(lk_traldf_eiv) THEN 378 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 379 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 380 DO ji = 1, jpi 381 z2d(ji,:) = z2d(1,:) 382 ENDDO 383 cl1 = 'sophteiv' 384 CALL iom_put( TRIM(cl1), z2d ) 385 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 386 DO ji = 1, jpi 387 z2d(ji,:) = z2d(1,:) 388 ENDDO 389 cl1 = 'sopsteiv' 390 CALL iom_put( TRIM(cl1), z2d ) 391 IF( ln_subbas ) THEN 392 DO jn=2,nptr 393 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 394 DO ji = 1, jpi 395 z2d(ji,:) = z2d(1,:) 396 ENDDO 397 cl1 = TRIM('sophteiv_'//clsubb(jn)) 398 CALL iom_put( cl1, z2d ) 399 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 400 DO ji = 1, jpi 401 z2d(ji,:) = z2d(1,:) 402 ENDDO 403 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 404 CALL iom_put( cl1, z2d ) 405 ENDDO 406 ENDIF 407 ENDIF 408 ENDIF 409 #endif 180 410 ! 181 411 ENDIF … … 256 486 ! Initialise arrays to zero because diatpr is called before they are first calculated 257 487 ! 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 488 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 489 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 490 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 491 htr_vt(:,:) = 0._wp ; str_vs(:,:) = 0._wp 492 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 493 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 260 494 ! 261 495 ENDIF … … 263 497 END SUBROUTINE dia_ptr_init 264 498 499 SUBROUTINE dia_ptr_ohst_components( ktra, cptr, pva ) 500 !!---------------------------------------------------------------------- 501 !! *** ROUTINE dia_ptr_ohst_components *** 502 !!---------------------------------------------------------------------- 503 !! Wrapper for heat and salt transport calculations to calculate them for each basin 504 !! Called from all advection and/or diffusion routines 505 !!---------------------------------------------------------------------- 506 INTEGER , INTENT(in ) :: ktra ! tracer index 507 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 508 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 509 INTEGER :: jn ! 510 511 IF( cptr == 'adv' ) THEN 512 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 513 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pva(:,:,:) ) 514 ENDIF 515 IF( cptr == 'ldf' ) THEN 516 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 517 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 518 ENDIF 519 IF( cptr == 'eiv' ) THEN 520 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 521 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 522 ENDIF 523 IF( cptr == 'vts' ) THEN 524 IF( ktra == jp_tem ) htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 525 IF( ktra == jp_sal ) str_vs(:,1) = ptr_sj( pva(:,:,:) ) 526 ENDIF 527 ! 528 IF( ln_subbas ) THEN 529 ! 530 IF( cptr == 'adv' ) THEN 531 IF( ktra == jp_tem ) THEN 532 DO jn = 2, nptr 533 htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 534 END DO 535 ENDIF 536 IF( ktra == jp_sal ) THEN 537 DO jn = 2, nptr 538 str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 539 END DO 540 ENDIF 541 ENDIF 542 IF( cptr == 'ldf' ) THEN 543 IF( ktra == jp_tem ) THEN 544 DO jn = 2, nptr 545 htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 546 END DO 547 ENDIF 548 IF( ktra == jp_sal ) THEN 549 DO jn = 2, nptr 550 str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 551 END DO 552 ENDIF 553 ENDIF 554 IF( cptr == 'eiv' ) THEN 555 IF( ktra == jp_tem ) THEN 556 DO jn = 2, nptr 557 htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 558 END DO 559 ENDIF 560 IF( ktra == jp_sal ) THEN 561 DO jn = 2, nptr 562 str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 563 END DO 564 ENDIF 565 ENDIF 566 IF( cptr == 'vts' ) THEN 567 IF( ktra == jp_tem ) THEN 568 DO jn = 2, nptr 569 htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 570 END DO 571 ENDIF 572 IF( ktra == jp_sal ) THEN 573 DO jn = 2, nptr 574 str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 575 END DO 576 ENDIF 577 ENDIF 578 ! 579 ENDIF 580 END SUBROUTINE dia_ptr_ohst_components 581 265 582 266 583 FUNCTION dia_ptr_alloc() … … 273 590 ierr(:) = 0 274 591 ! 275 ALLOCATE( btmsk(jpi,jpj,nptr) , & 276 & htr_adv(jpj) , str_adv(jpj) , & 277 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 592 ALLOCATE( btmsk(jpi,jpj,nptr) , & 593 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 594 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 595 & htr_vt(jpj,nptr) , str_vs(jpj,nptr) , & 596 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 597 & htr_btr(jpj,nptr) , str_btr(jpj,nptr) , & 598 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 278 599 ! 279 600 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) … … 402 723 #endif 403 724 !!-------------------------------------------------------------------- 404 725 ! 405 726 p_fval => p_fval2d 406 727 … … 434 755 #endif 435 756 ! 757 436 758 END FUNCTION ptr_sjk 437 759 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6498 r7179 323 323 CALL iom_put( "hdiv", hdivn ) ! Horizontal divergence 324 324 ! 325 IF( iom_use("u_masstr") .OR. iom_use("u_ heattr") .OR. iom_use("u_salttr") ) THEN325 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 326 326 z3d(:,:,jpk) = 0.e0 327 z2d(:,:) = 0.e0 327 328 DO jk = 1, jpkm1 328 329 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 330 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 329 331 END DO 330 332 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 333 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 331 334 ENDIF 332 335 … … 391 394 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 392 395 ENDIF 396 397 ! Vertical integral of temperature 398 IF( iom_use("tosmint") ) THEN 399 z2d(:,:)=0._wp 400 DO jk = 1, jpkm1 401 DO jj = 2, jpjm1 402 DO ji = fs_2, fs_jpim1 ! vector opt. 403 z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) 404 END DO 405 END DO 406 END DO 407 CALL lbc_lnk( z2d, 'T', -1. ) 408 CALL iom_put( "tosmint", z2d ) 409 ENDIF 410 411 ! Vertical integral of salinity 412 IF( iom_use("somint") ) THEN 413 z2d(:,:)=0._wp 414 DO jk = 1, jpkm1 415 DO jj = 2, jpjm1 416 DO ji = fs_2, fs_jpim1 ! vector opt. 417 z2d(ji,jj) = z2d(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 418 END DO 419 END DO 420 END DO 421 CALL lbc_lnk( z2d, 'T', -1. ) 422 CALL iom_put( "somint", z2d ) 423 ENDIF 424 425 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 393 426 ! 394 427 CALL wrk_dealloc( jpi , jpj , z2d )
Note: See TracChangeset
for help on using the changeset viewer.
