Changeset 7403 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2016-11-30T17:56:53+01:00 (8 years ago)
- Location:
- branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 3 edited
-
diaar5.F90 (modified) (7 diffs)
-
diaptr.F90 (modified) (12 diffs)
-
diawri.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6665 r7403 6 6 !! History : 3.2 ! 2009-11 (S. Masson) Original code 7 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 8 !!----------------------------------------------------------------------9 #if defined key_diaar510 !!----------------------------------------------------------------------11 !! 'key_diaar5' : activate ar5 diagnotics12 8 !!---------------------------------------------------------------------- 13 9 !! dia_ar5 : AR5 diagnostics … … 24 20 USE phycst ! physical constant 25 21 USE in_out_manager ! I/O manager 22 USE zdfddm 23 USE zdf_oce 26 24 27 25 IMPLICIT NONE … … 29 27 30 28 PUBLIC dia_ar5 ! routine called in step.F90 module 31 PUBLIC dia_ar5_init ! routine called in opa.F90 module32 29 PUBLIC dia_ar5_alloc ! routine called in nemogcm.F90 module 33 34 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE. ! coupled flag 30 PUBLIC dia_ar5_hst ! heat/salt transport 35 31 36 32 REAL(wp) :: vol0 ! ocean volume (interior domain) … … 39 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 40 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 37 38 LOGICAL :: l_ar5 41 39 40 !! * Substitutions 41 # include "zdfddm_substitute.h90" 42 # include "vectopt_loop_substitute.h90" 42 43 !!---------------------------------------------------------------------- 43 44 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 73 74 INTEGER :: ji, jj, jk ! dummy loop arguments 74 75 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 76 REAL(wp) :: zaw, zbw, zrw 75 77 ! 76 78 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 REAL(wp), POINTER, DIMENSION(:,:) :: zpe ! 2D workspace 77 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 78 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace … … 80 83 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') 81 84 82 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres ) 83 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 84 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 85 86 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 87 88 ! ! total volume of liquid seawater 89 zvolssh = SUM( zarea_ssh(:,:) ) 90 IF( lk_mpp ) CALL mpp_sum( zvolssh ) 91 zvol = vol0 + zvolssh 85 IF( kt == nit000 ) CALL dia_ar5_init 86 87 IF( l_ar5 ) THEN 88 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres ) 89 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 90 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 91 zarea_ssh(:,:) = area(:,:) * sshn(:,:) 92 ENDIF 93 ! 94 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 95 ! ! total volume of liquid seawater 96 zvolssh = SUM( zarea_ssh(:,:) ) 97 IF( lk_mpp ) CALL mpp_sum( zvolssh ) 98 zvol = vol0 + zvolssh 92 99 93 CALL iom_put( 'voltot', zvol ) 94 CALL iom_put( 'sshtot', zvolssh / area_tot ) 95 96 ! 97 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 98 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 99 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 100 ! 101 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 102 DO jk = 1, jpkm1 103 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 104 END DO 105 IF( ln_linssh ) THEN 106 IF( ln_isfcav ) THEN 107 DO ji=1,jpi 108 DO jj=1,jpj 109 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 110 END DO 111 END DO 112 ELSE 113 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 114 END IF 100 CALL iom_put( 'voltot', zvol ) 101 CALL iom_put( 'sshtot', zvolssh / area_tot ) 102 CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 103 ! 104 ENDIF 105 106 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 107 ! 108 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 109 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 110 CALL eos( ztsn, zrhd, gdept_n(:,:,:) ) ! now in situ density using initial salinity 111 ! 112 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 113 DO jk = 1, jpkm1 114 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 115 END DO 116 IF( ln_linssh ) THEN 117 IF( ln_isfcav ) THEN 118 DO ji = 1, jpi 119 DO jj = 1, jpj 120 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 121 END DO 122 END DO 123 ELSE 124 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 125 END IF 115 126 !!gm 116 127 !!gm riceload should be added in both ln_linssh=T or F, no? 117 128 !!gm 118 END IF119 !120 zarho = SUM( area(:,:) * zbotpres(:,:) )121 IF( lk_mpp ) CALL mpp_sum( zarho )122 zssh_steric = - zarho / area_tot123 CALL iom_put( 'sshthster', zssh_steric )129 END IF 130 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 132 IF( lk_mpp ) CALL mpp_sum( zarho ) 133 zssh_steric = - zarho / area_tot 134 CALL iom_put( 'sshthster', zssh_steric ) 124 135 125 ! ! steric sea surface height 126 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 127 zrhop(:,:,jpk) = 0._wp 128 CALL iom_put( 'rhop', zrhop ) 129 ! 130 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 136 ! ! steric sea surface height 137 CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density 138 zrhop(:,:,jpk) = 0._wp 139 CALL iom_put( 'rhop', zrhop ) 140 ! 141 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 142 DO jk = 1, jpkm1 143 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 144 END DO 145 IF( ln_linssh ) THEN 146 IF ( ln_isfcav ) THEN 147 DO ji = 1,jpi 148 DO jj = 1,jpj 149 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 150 END DO 151 END DO 152 ELSE 153 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 154 END IF 155 END IF 156 ! 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 IF( lk_mpp ) CALL mpp_sum( zarho ) 159 zssh_steric = - zarho / area_tot 160 CALL iom_put( 'sshsteric', zssh_steric ) 161 162 ! ! ocean bottom pressure 163 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 165 CALL iom_put( 'botpres', zbotpres ) 166 ! 167 ENDIF 168 169 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 170 ! ! Mean density anomalie, temperature and salinity 171 ztemp = 0._wp 172 zsal = 0._wp 173 DO jk = 1, jpkm1 174 DO jj = 1, jpj 175 DO ji = 1, jpi 176 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 177 ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 178 zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal) 179 END DO 180 END DO 181 END DO 182 IF( ln_linssh ) THEN 183 IF( ln_isfcav ) THEN 184 DO ji = 1, jpi 185 DO jj = 1, jpj 186 ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 187 zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 188 END DO 189 END DO 190 ELSE 191 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 192 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 193 END IF 194 ENDIF 195 IF( lk_mpp ) THEN 196 CALL mpp_sum( ztemp ) 197 CALL mpp_sum( zsal ) 198 END IF 199 ! 200 zmass = rau0 * ( zarho + zvol ) ! total mass of liquid seawater 201 ztemp = ztemp / zvol ! potential temperature in liquid seawater 202 zsal = zsal / zvol ! Salinity of liquid seawater 203 ! 204 CALL iom_put( 'masstot', zmass ) 205 CALL iom_put( 'temptot', ztemp ) 206 CALL iom_put( 'saltot' , zsal ) 207 ! 208 ENDIF 209 210 IF( iom_use( 'tnpeo' )) THEN 211 ! Work done against stratification by vertical mixing 212 ! Exclude points where rn2 is negative as convection kicks in here and 213 ! work is not being done against stratification 214 CALL wrk_alloc( jpi, jpj, zpe ) 215 zpe(:,:) = 0._wp 216 IF( lk_zdfddm ) THEN 217 DO ji=1,jpi 218 DO jj=1,jpj 219 DO jk=1,jpk 220 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 221 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 222 ! 223 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 224 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 225 ! 226 zpe(ji, jj) = zpe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 227 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 228 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 229 230 ENDDO 231 ENDDO 232 ENDDO 233 ELSE 234 DO ji = 1, jpi 235 DO jj = 1, jpj 236 DO jk = 1, jpk 237 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 238 ENDDO 239 ENDDO 240 ENDDO 241 ENDIF 242 CALL lbc_lnk( zpe, 'T', 1._wp) 243 CALL iom_put( 'tnpeo', zpe ) 244 CALL wrk_dealloc( jpi, jpj, zpe ) 245 ENDIF 246 ! 247 IF( l_ar5 ) THEN 248 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 249 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 250 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) 251 ENDIF 252 ! 253 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5') 254 ! 255 END SUBROUTINE dia_ar5 256 257 SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva ) 258 !!---------------------------------------------------------------------- 259 !! *** ROUTINE dia_ar5_htr *** 260 !!---------------------------------------------------------------------- 261 !! Wrapper for heat transport calculations 262 !! Called from all advection and/or diffusion routines 263 !!---------------------------------------------------------------------- 264 INTEGER , INTENT(in ) :: ktra ! tracer index 265 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 266 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pua ! 3D input array of advection/diffusion 267 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 268 ! 269 INTEGER :: ji, jj, jk 270 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 271 272 273 274 CALL wrk_alloc( jpi, jpj, z2d ) 275 z2d(:,:) = pua(:,:,1) 131 276 DO jk = 1, jpkm1 132 zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 133 END DO 134 IF( ln_linssh ) THEN 135 IF ( ln_isfcav ) THEN 136 DO ji=1,jpi 137 DO jj=1,jpj 138 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 139 END DO 277 DO jj = 2, jpjm1 278 DO ji = fs_2, fs_jpim1 ! vector opt. 279 z2d(ji,jj) = z2d(ji,jj) + pua(ji,jj,jk) 140 280 END DO 141 ELSE 142 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 143 END IF 144 END IF 145 ! 146 zarho = SUM( area(:,:) * zbotpres(:,:) ) 147 IF( lk_mpp ) CALL mpp_sum( zarho ) 148 zssh_steric = - zarho / area_tot 149 CALL iom_put( 'sshsteric', zssh_steric ) 150 151 ! ! ocean bottom pressure 152 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 153 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 154 CALL iom_put( 'botpres', zbotpres ) 155 156 ! ! Mean density anomalie, temperature and salinity 157 ztemp = 0._wp 158 zsal = 0._wp 159 DO jk = 1, jpkm1 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 163 ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 164 zsal = zsal + zztmp * tsn(ji,jj,jk,jp_sal) 165 END DO 166 END DO 167 END DO 168 IF( ln_linssh ) THEN 169 IF( ln_isfcav ) THEN 170 DO ji=1,jpi 171 DO jj=1,jpj 172 ztemp = ztemp + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_tem) 173 zsal = zsal + zarea_ssh(ji,jj) * tsn(ji,jj,mikt(ji,jj),jp_sal) 174 END DO 175 END DO 176 ELSE 177 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 178 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 179 END IF 180 ENDIF 181 IF( lk_mpp ) THEN 182 CALL mpp_sum( ztemp ) 183 CALL mpp_sum( zsal ) 184 END IF 185 ! 186 zmass = rau0 * ( zarho + zvol ) ! total mass of liquid seawater 187 ztemp = ztemp / zvol ! potential temperature in liquid seawater 188 zsal = zsal / zvol ! Salinity of liquid seawater 189 ! 190 CALL iom_put( 'masstot', zmass ) 191 CALL iom_put( 'temptot', ztemp ) 192 CALL iom_put( 'saltot' , zsal ) 193 ! 194 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 195 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 196 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) 197 ! 198 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5') 199 ! 200 END SUBROUTINE dia_ar5 281 END DO 282 END DO 283 CALL lbc_lnk( z2d, 'U', -1. ) 284 IF( cptr == 'adv' ) THEN 285 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in i-direction 286 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0 * z2d ) ! advective salt transport in i-direction 287 ENDIF 288 IF( cptr == 'ldf' ) THEN 289 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 290 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0 * z2d ) ! diffusive salt transport in i-direction 291 ENDIF 292 ! 293 z2d(:,:) = pva(:,:,1) 294 DO jk = 1, jpkm1 295 DO jj = 2, jpjm1 296 DO ji = fs_2, fs_jpim1 ! vector opt. 297 z2d(ji,jj) = z2d(ji,jj) + pva(ji,jj,jk) 298 END DO 299 END DO 300 END DO 301 CALL lbc_lnk( z2d, 'V', -1. ) 302 IF( cptr == 'adv' ) THEN 303 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in j-direction 304 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0 * z2d ) ! advective salt transport in j-direction 305 ENDIF 306 IF( cptr == 'ldf' ) THEN 307 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 308 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0 * z2d ) ! diffusive salt transport in j-direction 309 ENDIF 310 311 CALL wrk_dealloc( jpi, jpj, z2d ) 312 313 END SUBROUTINE dia_ar5_hst 201 314 202 315 … … 217 330 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 218 331 ! 219 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 220 ! ! allocate dia_ar5 arrays 221 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 222 223 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 224 225 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 226 227 vol0 = 0._wp 228 thick0(:,:) = 0._wp 229 DO jk = 1, jpkm1 230 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 231 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 232 END DO 233 IF( lk_mpp ) CALL mpp_sum( vol0 ) 234 235 236 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 237 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 238 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 239 CALL iom_close( inum ) 240 241 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 242 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 243 IF( ln_zps ) THEN ! z-coord. partial steps 244 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 245 DO ji = 1, jpi 246 ik = mbkt(ji,jj) 247 IF( ik > 1 ) THEN 248 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 249 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 250 ENDIF 332 l_ar5 = .FALSE. 333 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 334 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 335 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) L_ar5 = .TRUE. 336 337 IF( l_ar5 ) THEN 338 ! 339 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 340 ! ! allocate dia_ar5 arrays 341 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 342 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 344 345 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) 346 347 vol0 = 0._wp 348 thick0(:,:) = 0._wp 349 DO jk = 1, jpkm1 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 353 IF( lk_mpp ) CALL mpp_sum( vol0 ) 354 355 356 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 357 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 358 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 359 CALL iom_close( inum ) 360 361 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 362 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 363 IF( ln_zps ) THEN ! z-coord. partial steps 364 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 365 DO ji = 1, jpi 366 ik = mbkt(ji,jj) 367 IF( ik > 1 ) THEN 368 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 369 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 370 ENDIF 371 END DO 251 372 END DO 252 END DO 253 ENDIF 254 ! 255 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 373 ENDIF 374 ! 375 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 376 ! 377 ENDIF 256 378 ! 257 379 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') 258 380 ! 259 381 END SUBROUTINE dia_ar5_init 260 261 #else262 !!----------------------------------------------------------------------263 !! Default option : NO diaar5264 !!----------------------------------------------------------------------265 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE. ! coupled flag266 CONTAINS267 SUBROUTINE dia_ar5_init ! Dummy routine268 END SUBROUTINE dia_ar5_init269 SUBROUTINE dia_ar5( kt ) ! Empty routine270 INTEGER :: kt271 WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt272 END SUBROUTINE dia_ar5273 #endif274 382 275 383 !!====================================================================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r6140 r7403 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 … … 38 39 PUBLIC dia_ptr_init ! call in step module 39 40 PUBLIC dia_ptr ! call in step module 41 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 40 42 41 43 ! !!** namelist namptr ** 42 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 44 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv !: Heat TRansports (adv, diff, Bolus.) 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv !: 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 ) 45 48 46 49 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 47 50 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 48 INTEGER 51 INTEGER, PUBLIC :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 49 52 50 53 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 75 78 ! 76 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices 77 REAL(wp) :: z v, zsfc ! local scalar80 REAL(wp) :: zsfc,zvfc ! local scalar 78 81 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 79 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 80 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 81 84 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 82 CHARACTER( len = 10 ) :: cl1 85 REAL(wp), DIMENSION(jpj) :: vsum ! 1D workspace 86 REAL(wp), DIMENSION(jpj,jpts) :: tssum ! 1D workspace 87 88 ! 89 !overturning calculation 90 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 91 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace 93 94 95 CHARACTER( len = 12 ) :: cl1 83 96 !!---------------------------------------------------------------------- 84 97 ! … … 109 122 END DO 110 123 ENDIF 124 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 125 ! define fields multiplied by scalar 126 zmask(:,:,:) = 0._wp 127 zts(:,:,:,:) = 0._wp 128 zvn(:,:,:) = 0._wp 129 DO jk = 1, jpkm1 130 DO jj = 1, jpjm1 131 DO ji = 1, jpi 132 zvfc = e1v(ji,jj) * e3v_n(ji,jj,jk) 133 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc 134 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 135 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 136 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc 137 ENDDO 138 ENDDO 139 ENDDO 140 ENDIF 141 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 142 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 143 r1_sjk(:,:,1) = 0._wp 144 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 145 146 ! i-mean T and S, j-Stream-Function, global 147 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 148 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 149 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) ) 150 151 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 152 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 153 154 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 155 DO ji = 1, jpi 156 z2d(ji,:) = z2d(1,:) 157 ENDDO 158 cl1 = 'sophtove' 159 CALL iom_put( TRIM(cl1), z2d ) 160 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 161 DO ji = 1, jpi 162 z2d(ji,:) = z2d(1,:) 163 ENDDO 164 cl1 = 'sopstove' 165 CALL iom_put( TRIM(cl1), z2d ) 166 IF( ln_subbas ) THEN 167 DO jn = 2, nptr 168 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 169 r1_sjk(:,:,jn) = 0._wp 170 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 171 172 ! i-mean T and S, j-Stream-Function, basin 173 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 174 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 175 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 176 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 177 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 178 179 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 180 DO ji = 1, jpi 181 z2d(ji,:) = z2d(1,:) 182 ENDDO 183 cl1 = TRIM('sophtove_'//clsubb(jn)) 184 CALL iom_put( cl1, z2d ) 185 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 186 DO ji = 1, jpi 187 z2d(ji,:) = z2d(1,:) 188 ENDDO 189 cl1 = TRIM('sopstove_'//clsubb(jn)) 190 CALL iom_put( cl1, z2d ) 191 END DO 192 ENDIF 193 ENDIF 194 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 195 ! Calculate barotropic heat and salt transport here 196 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 197 r1_sjk(:,1,1) = 0._wp 198 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 199 200 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1)) 201 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 202 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 203 htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 204 str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 205 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 206 DO ji = 2, jpi 207 z2d(ji,:) = z2d(1,:) 208 ENDDO 209 cl1 = 'sophtbtr' 210 CALL iom_put( TRIM(cl1), z2d ) 211 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 212 DO ji = 2, jpi 213 z2d(ji,:) = z2d(1,:) 214 ENDDO 215 cl1 = 'sopstbtr' 216 CALL iom_put( TRIM(cl1), z2d ) 217 IF( ln_subbas ) THEN 218 DO jn = 2, nptr 219 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 220 r1_sjk(:,1,jn) = 0._wp 221 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 222 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn)) 223 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 224 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 225 htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 226 str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 227 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 228 DO ji = 1, jpi 229 z2d(ji,:) = z2d(1,:) 230 ENDDO 231 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 232 CALL iom_put( cl1, z2d ) 233 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 234 DO ji = 1, jpi 235 z2d(ji,:) = z2d(1,:) 236 ENDDO 237 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 238 CALL iom_put( cl1, z2d ) 239 ENDDO 240 ENDIF !ln_subbas 241 ENDIF !iom_use("sopstbtr....) 111 242 ! 112 243 ELSE … … 148 279 ! ! Advective and diffusive heat and salt transport 149 280 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 150 z2d(1,:) = htr_adv(: ) * rc_pwatt ! (conversion in PW)281 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 151 282 DO ji = 1, jpi 152 283 z2d(ji,:) = z2d(1,:) … … 154 285 cl1 = 'sophtadv' 155 286 CALL iom_put( TRIM(cl1), z2d ) 156 z2d(1,:) = str_adv(: ) * rc_ggram ! (conversion in Gg)287 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 157 288 DO ji = 1, jpi 158 289 z2d(ji,:) = z2d(1,:) … … 160 291 cl1 = 'sopstadv' 161 292 CALL iom_put( TRIM(cl1), z2d ) 293 IF( ln_subbas ) THEN 294 DO jn=2,nptr 295 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 296 DO ji = 1, jpi 297 z2d(ji,:) = z2d(1,:) 298 ENDDO 299 cl1 = TRIM('sophtadv_'//clsubb(jn)) 300 CALL iom_put( cl1, z2d ) 301 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 302 DO ji = 1, jpi 303 z2d(ji,:) = z2d(1,:) 304 ENDDO 305 cl1 = TRIM('sopstadv_'//clsubb(jn)) 306 CALL iom_put( cl1, z2d ) 307 ENDDO 308 ENDIF 162 309 ENDIF 163 310 ! 164 311 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 165 z2d(1,:) = htr_ldf(: ) * rc_pwatt ! (conversion in PW)312 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 166 313 DO ji = 1, jpi 167 314 z2d(ji,:) = z2d(1,:) … … 169 316 cl1 = 'sophtldf' 170 317 CALL iom_put( TRIM(cl1), z2d ) 171 z2d(1,:) = str_ldf(: ) * rc_ggram ! (conversion in Gg)318 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 172 319 DO ji = 1, jpi 173 320 z2d(ji,:) = z2d(1,:) … … 175 322 cl1 = 'sopstldf' 176 323 CALL iom_put( TRIM(cl1), z2d ) 324 IF( ln_subbas ) THEN 325 DO jn=2,nptr 326 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 327 DO ji = 1, jpi 328 z2d(ji,:) = z2d(1,:) 329 ENDDO 330 cl1 = TRIM('sophtldf_'//clsubb(jn)) 331 CALL iom_put( cl1, z2d ) 332 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 333 DO ji = 1, jpi 334 z2d(ji,:) = z2d(1,:) 335 ENDDO 336 cl1 = TRIM('sopstldf_'//clsubb(jn)) 337 CALL iom_put( cl1, z2d ) 338 ENDDO 339 ENDIF 340 ENDIF 341 342 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 343 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 344 DO ji = 1, jpi 345 z2d(ji,:) = z2d(1,:) 346 ENDDO 347 cl1 = 'sophteiv' 348 CALL iom_put( TRIM(cl1), z2d ) 349 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 350 DO ji = 1, jpi 351 z2d(ji,:) = z2d(1,:) 352 ENDDO 353 cl1 = 'sopsteiv' 354 CALL iom_put( TRIM(cl1), z2d ) 355 IF( ln_subbas ) THEN 356 DO jn=2,nptr 357 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 358 DO ji = 1, jpi 359 z2d(ji,:) = z2d(1,:) 360 ENDDO 361 cl1 = TRIM('sophteiv_'//clsubb(jn)) 362 CALL iom_put( cl1, z2d ) 363 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 364 DO ji = 1, jpi 365 z2d(ji,:) = z2d(1,:) 366 ENDDO 367 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 368 CALL iom_put( cl1, z2d ) 369 ENDDO 370 ENDIF 177 371 ENDIF 178 372 ! … … 254 448 ! Initialise arrays to zero because diatpr is called before they are first calculated 255 449 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 256 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp 257 htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 450 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 451 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 452 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 453 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 454 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 258 455 ! 259 456 ENDIF … … 261 458 END SUBROUTINE dia_ptr_init 262 459 460 SUBROUTINE dia_ptr_hst( ktra, cptr, pva ) 461 !!---------------------------------------------------------------------- 462 !! *** ROUTINE dia_ptr_hst *** 463 !!---------------------------------------------------------------------- 464 !! Wrapper for heat and salt transport calculations to calculate them for each basin 465 !! Called from all advection and/or diffusion routines 466 !!---------------------------------------------------------------------- 467 INTEGER , INTENT(in ) :: ktra ! tracer index 468 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf'/'eiv' 469 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pva ! 3D input array of advection/diffusion 470 INTEGER :: jn ! 471 472 IF( cptr == 'adv' ) THEN 473 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pva(:,:,:) ) 474 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pva(:,:,:) ) 475 ENDIF 476 IF( cptr == 'ldf' ) THEN 477 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pva(:,:,:) ) 478 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 479 ENDIF 480 IF( cptr == 'eiv' ) THEN 481 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 482 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 483 ENDIF 484 ! 485 IF( ln_subbas ) THEN 486 ! 487 IF( cptr == 'adv' ) THEN 488 IF( ktra == jp_tem ) THEN 489 DO jn = 2, nptr 490 htr_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 491 END DO 492 ENDIF 493 IF( ktra == jp_sal ) THEN 494 DO jn = 2, nptr 495 str_adv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 496 END DO 497 ENDIF 498 ENDIF 499 IF( cptr == 'ldf' ) THEN 500 IF( ktra == jp_tem ) THEN 501 DO jn = 2, nptr 502 htr_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 503 END DO 504 ENDIF 505 IF( ktra == jp_sal ) THEN 506 DO jn = 2, nptr 507 str_ldf(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 508 END DO 509 ENDIF 510 ENDIF 511 IF( cptr == 'eiv' ) THEN 512 IF( ktra == jp_tem ) THEN 513 DO jn = 2, nptr 514 htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 515 END DO 516 ENDIF 517 IF( ktra == jp_sal ) THEN 518 DO jn = 2, nptr 519 str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 520 END DO 521 ENDIF 522 ENDIF 523 ! 524 ENDIF 525 END SUBROUTINE dia_ptr_hst 526 263 527 264 528 FUNCTION dia_ptr_alloc() … … 271 535 ierr(:) = 0 272 536 ! 273 ALLOCATE( btmsk(jpi,jpj,nptr) , & 274 & htr_adv(jpj) , str_adv(jpj) , & 275 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 537 ALLOCATE( btmsk(jpi,jpj,nptr) , & 538 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 539 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 540 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 541 & htr_btr(jpj,nptr) , str_btr(jpj,nptr) , & 542 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 276 543 ! 277 544 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6387 r7403 302 302 CALL iom_put( "hdiv", hdivn ) ! Horizontal divergence 303 303 ! 304 IF( iom_use("u_masstr") .OR. iom_use("u_ heattr") .OR. iom_use("u_salttr") ) THEN304 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 305 305 z3d(:,:,jpk) = 0.e0 306 z2d(:,:) = 0.e0 306 307 DO jk = 1, jpkm1 307 308 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 309 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 308 310 END DO 309 311 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 312 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 310 313 ENDIF 311 314 … … 370 373 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 371 374 ENDIF 375 376 ! Vertical integral of temperature 377 IF( iom_use("tosmint") ) THEN 378 z2d(:,:)=0._wp 379 DO jk = 1, jpkm1 380 DO jj = 2, jpjm1 381 DO ji = fs_2, fs_jpim1 ! vector opt. 382 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) 383 END DO 384 END DO 385 END DO 386 CALL lbc_lnk( z2d, 'T', -1. ) 387 CALL iom_put( "tosmint", z2d ) 388 ENDIF 389 390 ! Vertical integral of salinity 391 IF( iom_use("somint") ) THEN 392 z2d(:,:)=0._wp 393 DO jk = 1, jpkm1 394 DO jj = 2, jpjm1 395 DO ji = fs_2, fs_jpim1 ! vector opt. 396 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 397 END DO 398 END DO 399 END DO 400 CALL lbc_lnk( z2d, 'T', -1. ) 401 CALL iom_put( "somint", z2d ) 402 ENDIF 403 404 CALL iom_put( "bn2", rn2 ) !Brunt-Vaisala buoyancy frequency (N^2) 372 405 ! 373 406 CALL wrk_dealloc( jpi , jpj , z2d )
Note: See TracChangeset
for help on using the changeset viewer.
