Changeset 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6665 r7646 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 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 356 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 357 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 358 CALL iom_close( inum ) 359 360 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 361 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 362 IF( ln_zps ) THEN ! z-coord. partial steps 363 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 364 DO ji = 1, jpi 365 ik = mbkt(ji,jj) 366 IF( ik > 1 ) THEN 367 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 368 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 369 ENDIF 370 END DO 251 371 END DO 252 END DO 253 ENDIF 254 ! 255 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 372 ENDIF 373 ! 374 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 375 ! 376 ENDIF 256 377 ! 257 378 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') 258 379 ! 259 380 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 381 275 382 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
