Changeset 7179 for branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2016-11-03T16:39:56+01:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 1 deleted
- 26 edited
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 ) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r6486 r7179 166 166 ! 167 167 ENDIF 168 IF( l_trddyn ) THEN ! Put here so code doesn't crash when doing KE trend but needs to be done properly 169 CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv ) 170 ENDIF 168 171 ! 169 172 ELSE ! fixed volume (add the surface pressure gradient + unweighted time stepping) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r6498 r7179 228 228 ! automatic definitions of some of the xml attributs 229 229 CALL set_xmlatt 230 231 CALL set_1point 230 232 231 233 ! end file definition … … 1579 1581 END SUBROUTINE set_scalar 1580 1582 1583 SUBROUTINE set_1point 1584 !!---------------------------------------------------------------------- 1585 !! *** ROUTINE set_1point *** 1586 !! 1587 !! ** Purpose : define zoom grid for scalar fields 1588 !! 1589 !!---------------------------------------------------------------------- 1590 REAL(wp), DIMENSION(1) :: zz = 1. 1591 INTEGER :: ix, iy 1592 !!---------------------------------------------------------------------- 1593 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! Nearest point to north pole should be ocean 1594 CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 1595 1596 END SUBROUTINE set_1point 1597 1598 1581 1599 1582 1600 SUBROUTINE set_xmlatt -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6912 r7179 1728 1728 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1729 1729 #endif 1730 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1730 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1) ) ! liquid precipitation 1731 CALL iom_put( 'rain_ao_cea' , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1) ) ! liquid precipitation 1731 1732 IF( iom_use('hflx_rain_cea') ) & 1732 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1733 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1)) ! heat flux from liq. precip. 1734 IF( iom_use('hflx_prec_cea') ) & 1735 & CALL iom_put( 'hflx_prec_cea', ztprecip * zcptn(:,:) * tmask(:,:,1) * p_frld(:,:) ) ! heat content flux from all precip (cell avg) 1736 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1737 & ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1733 1738 IF( iom_use('evap_ao_cea' ) ) & 1734 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )! ice-free oce evap (cell average)1739 & CALL iom_put( 'evap_ao_cea' , ztmp * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1735 1740 IF( iom_use('hflx_evap_cea') ) & 1736 & CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) )! heat flux from from evap (cell average)1741 & CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from from evap (cell average) 1737 1742 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1738 1743 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1798 1803 ! runoffs and calving (put in emp_tot) 1799 1804 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1805 IF( iom_use('hflx_rnf_cea') ) & 1806 CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 1800 1807 IF( srcv(jpr_cal)%laction ) THEN 1801 1808 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r6755 r7179 91 91 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale 92 92 INTEGER :: ios ! Local integer output status for namelist read 93 94 REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 95 REAL(wp), DIMENSION(:,: ), POINTER :: zqhcisf2d 93 96 ! 94 97 !!--------------------------------------------------------------------- … … 355 358 356 359 ! output 357 IF( iom_use('q isf' ) ) CALL iom_put('qisf', qisf)358 IF( iom_use('fwfisf' ) ) CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )360 IF( iom_use('qlatisf' ) ) CALL iom_put('qlatisf', qisf) 361 IF( iom_use('fwfisf' ) ) CALL iom_put('fwfisf' , fwfisf * stbl(:,:) / soce ) 359 362 360 363 ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now … … 366 369 CALL lbc_lnk(fwfisf(:,:) ,'T',1.) 367 370 CALL lbc_lnk(qisf(:,:) ,'T',1.) 371 372 !============================================================================================================================================= 373 IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 374 CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 375 CALL wrk_alloc( jpi,jpj, zqhcisf2d ) 376 377 zfwfisf3d(:,:,:) = 0.0_wp ! 3d ice shelf melting (kg/m2/s) 378 zqhcisf3d(:,:,:) = 0.0_wp ! 3d heat content flux (W/m2) 379 zqlatisf3d(:,:,:)= 0.0_wp ! 3d ice shelf melting latent heat flux (W/m2) 380 zqhcisf2d(:,:) = fwfisf(:,:) * zt_frz * rcp ! 2d heat content flux (W/m2) 381 382 DO jj = 1,jpj 383 DO ji = 1,jpi 384 ikt = misfkt(ji,jj) 385 ikb = misfkb(ji,jj) 386 DO jk = ikt, ikb - 1 387 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 388 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 389 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 390 END DO 391 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 392 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 393 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 394 END DO 395 END DO 396 397 CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:)) 398 CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:)) 399 CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:)) 400 CALL iom_put('qhcisf' , zqhcisf2d (:,: )) 401 402 CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 403 CALL wrk_dealloc( jpi,jpj, zqhcisf2d ) 404 END IF 405 !============================================================================================================================================= 368 406 369 407 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r6498 r7179 279 279 END IF 280 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 281 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 282 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 283 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 284 ENDIF 281 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 285 282 ! 286 283 END DO -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r7061 r7179 29 29 USE timing ! Timing 30 30 USE diaptr ! Heat/Salt transport diagnostics 31 USE trddyn 32 USE trd_oce 31 33 32 34 IMPLICIT NONE … … 163 165 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 164 166 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 165 167 IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value 168 z2d(:,:) = rau0 * e12t(:,:) 169 DO jk = 1, jpk 170 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 171 END DO 172 CALL iom_put( "weiv_masstr" , z3d ) 173 ENDIF 166 174 IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d') & 167 175 .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 168 176 z3d(:,:,jpk) = 0.e0 177 z2d(:,:) = 0.e0 169 178 DO jk = 1, jpkm1 170 179 z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 180 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 171 181 END DO 172 182 CALL iom_put( "ueiv_masstr", z3d ) ! mass transport in i-direction … … 305 315 306 316 END IF 317 ! 318 IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 319 z3d(:,:,:) = 0._wp 320 DO jk = 1, jpkm1 321 DO jj = 2, jpjm1 322 DO ji = fs_2, fs_jpim1 ! vector opt. 323 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 324 & * e1v(ji,jj) * fse3v(ji,jj,jk) 325 END DO 326 END DO 327 END DO 328 CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 329 z3d(:,:,:) = 0._wp 330 DO jk = 1, jpkm1 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 ! vector opt. 333 z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 334 & * e1v(ji,jj) * fse3v(ji,jj,jk) 335 END DO 336 END DO 337 END DO 338 CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 339 ENDIF 340 341 IF( ln_KE_trd ) CALL trd_dyn(u_eiv, v_eiv, jpdyn_eivke, kt ) 307 342 # endif 308 343 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r6486 r7179 219 219 END IF 220 220 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 221 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 222 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 223 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 224 ENDIF 221 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 225 222 226 223 ! II. Vertical advective fluxes -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r6486 r7179 200 200 201 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 202 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 203 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 204 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 205 ENDIF 202 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 206 203 207 204 ! II. Vertical advective fluxes -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r6486 r7179 355 355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 356 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 357 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 358 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 359 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 360 ENDIF 357 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', zwy(:,:,:) ) 361 358 ! 362 359 END DO -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6795 r7179 34 34 USE timing ! Timing 35 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 USE iom 36 37 37 38 IMPLICIT NONE … … 42 43 43 44 LOGICAL :: l_trd ! flag to compute trends 45 LOGICAL :: l_trans ! flag to output vertically integrated transports 44 46 45 47 !! * Substitutions … … 85 87 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 86 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 90 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 88 91 !!---------------------------------------------------------------------- 89 92 ! … … 98 101 ! 99 102 l_trd = .FALSE. 103 l_trans = .FALSE. 100 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 101 106 ENDIF 102 107 ! 103 IF( l_trd ) THEN108 IF( l_trd .OR. l_trans ) THEN 104 109 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 105 110 ztrdx(:,:,:) = 0.e0 ; ztrdy(:,:,:) = 0.e0 ; ztrdz(:,:,:) = 0.e0 111 CALL wrk_alloc( jpi, jpj, z2d ) 112 ENDIF 113 ! 114 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 115 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 116 zptry(:,:,:) = 0._wp 106 117 ENDIF 107 118 ! … … 187 198 188 199 ! ! trend diagnostics (contribution of upstream fluxes) 189 IF( l_trd ) THEN200 IF( l_trd .OR. l_trans ) THEN 190 201 ! store intermediate advective trends 191 202 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 192 203 END IF 193 204 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 194 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 195 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 196 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 197 ENDIF 205 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 198 206 199 207 ! 3. antidiffusive flux : high order minus low order … … 253 261 254 262 ! ! trend diagnostics (contribution of upstream fluxes) 255 IF( l_trd ) THEN263 IF( l_trd .OR. l_trans ) THEN 256 264 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 257 265 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 258 266 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 259 260 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 261 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 262 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 267 ENDIF 268 269 IF( l_trd ) THEN 270 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 271 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 272 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 263 273 END IF 264 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 274 275 IF( l_trans .AND. jn==jp_tem ) THEN 276 z2d(:,:) = 0._wp 277 DO jk = 1, jpkm1 278 DO jj = 2, jpjm1 279 DO ji = fs_2, fs_jpim1 ! vector opt. 280 z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk) 281 END DO 282 END DO 283 END DO 284 CALL lbc_lnk( z2d, 'U', -1. ) 285 CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! heat transport in i-direction 286 ! 287 z2d(:,:) = 0._wp 288 DO jk = 1, jpkm1 289 DO jj = 2, jpjm1 290 DO ji = fs_2, fs_jpim1 ! vector opt. 291 z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk) 292 END DO 293 END DO 294 END DO 295 CALL lbc_lnk( z2d, 'V', -1. ) 296 CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! heat transport in j-direction 297 ENDIF 298 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 265 299 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 266 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)267 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)300 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 301 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 268 302 ENDIF 269 303 ! 270 304 END DO 271 305 ! 272 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 273 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 306 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 307 IF( l_trd .OR. l_trans ) THEN 308 CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 309 CALL wrk_dealloc( jpi, jpj, z2d ) 310 ENDIF 311 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 274 312 ! 275 313 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd') … … 318 356 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz, zhdiv, zwz_sav, zwzts 319 357 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 358 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 320 359 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 321 360 !!---------------------------------------------------------------------- … … 339 378 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 340 379 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 380 ENDIF 381 ! 382 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 383 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 384 zptry(:,:,:) = 0._wp 341 385 ENDIF 342 386 ! … … 428 472 END IF 429 473 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 430 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 431 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 432 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 433 ENDIF 474 IF( cdtype == 'TRA' .AND. ln_diaptr ) zptry(:,:,:) = zwy(:,:,:) 434 475 435 476 ! 3. antidiffusive flux : high order minus low order … … 556 597 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 557 598 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 558 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:)559 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:)599 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) 600 CALL dia_ptr_ohst_components( jn, 'adv', zptry(:,:,:) ) 560 601 ENDIF 561 602 ! … … 566 607 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 567 608 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 609 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 568 610 ! 569 611 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_tvd_zts') -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r6486 r7179 177 177 END IF 178 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 ENDIF 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'adv', ztv(:,:,:) ) 183 180 184 181 ! TVD scheme for the vertical direction -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r6486 r7179 173 173 ! 174 174 ! "zonal" mean lateral diffusive heat and salt transport 175 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 176 IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 177 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 178 ENDIF 175 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 179 176 ! ! =========== 180 177 END DO ! tracer loop -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r6486 r7179 247 247 ! ! =============== 248 248 ! "Poleward" diffusive heat or salt transport 249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 250 ! note sign is reversed to give down-gradient diffusive transports (#1043) 251 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 252 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 253 ENDIF 249 ! note sign is reversed to give down-gradient diffusive transports (#1043) 250 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 254 251 255 252 ! ! ************ ! ! =============== -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r7061 r7179 244 244 ! 245 245 ! "Poleward" diffusive heat or salt transports (T-S case only) 246 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN247 246 ! note sign is reversed to give down-gradient diffusive transports (#1043) 248 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 249 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 250 ENDIF 247 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', -zftv(:,:,:) ) 251 248 252 249 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN … … 353 350 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 354 351 DEALLOCATE( ztrax, ztray, ztraz ) 355 IF( l_trdtra ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T )352 IF( l_trdtra .and. cdtype == 'TRA' ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T ) 356 353 ! 357 354 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r6486 r7179 386 386 ! 387 387 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 389 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 390 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 391 ENDIF 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', zftv(:,:,:) ) 392 389 393 390 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r6486 r7179 154 154 ! 155 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 159 ENDIF 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) ) 160 157 ! ! ================== 161 158 END DO ! end of tracer loop -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r7061 r7179 62 62 ! 63 63 ! !!!* Momentum trends indices 64 INTEGER, PUBLIC, PARAMETER :: jptot_dyn = 1 5!: Total trend nb: change it when adding/removing one indice below64 INTEGER, PUBLIC, PARAMETER :: jptot_dyn = 16 !: Total trend nb: change it when adding/removing one indice below 65 65 ! =============== ! 66 66 INTEGER, PUBLIC, PARAMETER :: jpdyn_hpg = 1 !: hydrostatic pressure gradient … … 79 79 INTEGER, PUBLIC, PARAMETER :: jpdyn_spgflt = 14 !: filter contribution to surface pressure gradient (spg_flt) 80 80 INTEGER, PUBLIC, PARAMETER :: jpdyn_spgexp = 15 !: explicit contribution to surface pressure gradient (spg_flt) 81 INTEGER, PUBLIC, PARAMETER :: jpdyn_eivke = 16 !: K.E trend from Gent McWilliams scheme 81 82 ! 82 83 !!---------------------------------------------------------------------- -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r6487 r7179 27 27 USE lib_mpp ! MPP library 28 28 USE wrk_nemo ! Memory allocation 29 USE ldfslp ! Isopycnal slopes 29 30 30 31 IMPLICIT NONE … … 42 43 # include "domzgr_substitute.h90" 43 44 # include "vectopt_loop_substitute.h90" 45 # include "ldfeiv_substitute.h90" 46 44 47 !!---------------------------------------------------------------------- 45 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 192 195 CALL ken_p2k( kt , zke ) 193 196 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 197 CASE( jpdyn_eivke ) 198 ! CMIP6 diagnostic tknebto = tendency of KE from 199 ! parameterized mesoscale eddy advection 200 ! = vertical_integral( k (N S)^2 ) rho dz 201 ! rho = reference density 202 ! S = isoneutral slope. 203 ! Most terms are on W grid so work on this grid 204 CALL wrk_alloc( jpi, jpj, zke2d ) 205 zke2d(:,:) = 0._wp 206 DO jk = 1,jpk 207 DO ji = 1,jpi 208 DO jj = 1,jpj 209 zke2d(ji,jj) = zke2d(ji,jj) + rau0 * fsaeiw(ji, jj, jk) & 210 & * ( wslpi(ji, jj, jk) * wslpi(ji,jj,jk) & 211 & + wslpj(ji, jj, jk) * wslpj(ji,jj,jk) ) & 212 & * rn2(ji,jj,jk) * fse3w(ji, jj, jk) 213 ENDDO 214 ENDDO 215 ENDDO 216 CALL iom_put("ketrd_eiv", zke2d) 217 CALL wrk_dealloc( jpi, jpj, zke2d ) 194 218 ! 195 219 END SELECT -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r6487 r7179 150 150 rab_pe(:,:,:,:) = 0._wp 151 151 ! 152 IF ( lk_vvl ) CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume')152 ! IF ( lk_vvl ) CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume') 153 153 ! 154 154 nkstp = nit000 - 1 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r7061 r7179 130 130 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 131 131 DO jk = 2, jpk 132 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)132 zwt(:,:,jk) = avt_k(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 133 133 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 134 134 END DO -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r6533 r7179 147 147 ! no need to output in offline mode 148 148 IF( .NOT.lk_offline ) THEN 149 IF( kt >= nit000 ) THEN ! workaround for calls before SOMETHING reads the XIOS namelist150 149 IF ( iom_use("mldr10_1") ) THEN 151 150 IF( ln_isfcav ) THEN … … 162 161 END IF 163 162 END IF 164 ENDIF165 163 ENDIF 166 164 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r6498 r7179 918 918 CALL iom_put( "pcmap_tmx", pcmap_tmx ) 919 919 ENDIF 920 CALL iom_put( "bn2", rn2 )921 920 CALL iom_put( "emix_tmx", emix_tmx ) 922 921
Note: See TracChangeset
for help on using the changeset viewer.