- Timestamp:
- 2019-12-07T12:40:06+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12072_TOP-01_ENHANCE-11_CEthe/src/OCE/DIA/diaar5.F90
r11993 r12109 71 71 INTEGER, INTENT( in ) :: kt ! ocean time-step index 72 72 ! 73 INTEGER :: ji, jj, jk ! dummy loop arguments74 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 73 INTEGER :: ji, jj, jk, iks, ikb ! dummy loop arguments 74 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass, zsst 75 75 REAL(wp) :: zaw, zbw, zrw 76 76 ! 77 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe, z2d ! 2D workspace 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop, ztpot ! 3D workspace 80 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 81 … … 86 86 87 87 IF( l_ar5 ) THEN 88 ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(jpi,jpj) )88 ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 89 89 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 90 90 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) … … 92 92 ENDIF 93 93 ! 94 CALL iom_put( 'e2u' , e2u (:,:) ) 95 CALL iom_put( 'e1v' , e1v (:,:) ) 96 CALL iom_put( 'areacello', area(:,:) ) 97 ! 98 IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN 99 zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace 100 DO jk = 1, jpkm1 101 zrhd(:,:,jk) = area(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 102 END DO 103 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 104 CALL iom_put( 'masscello' , rau0 * e3t_n(:,:,:) * tmask(:,:,:) ) ! ocean mass 105 ENDIF 106 ! 107 IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness 108 DO jj = 1, jpj 109 DO ji = 1, jpi 110 ikb = mbkt(ji,jj) 111 z2d(ji,jj) = e3t_n(ji,jj,ikb) 112 END DO 113 END DO 114 CALL iom_put( 'e3tb', z2d ) 115 ENDIF 116 ! 94 117 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 95 118 ! ! total volume of liquid seawater 96 zvolssh = SUM( zarea_ssh(:,:) ) 97 CALL mpp_sum( 'diaar5', zvolssh ) 98 zvol = vol0 + zvolssh 119 zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 120 zvol = vol0 + zvolssh 99 121 100 122 CALL iom_put( 'voltot', zvol ) … … 118 140 DO ji = 1, jpi 119 141 DO jj = 1, jpj 120 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 142 iks = mikt(ji,jj) 143 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,iks) + riceload(ji,jj) 121 144 END DO 122 145 END DO … … 129 152 END IF 130 153 ! 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 132 CALL mpp_sum( 'diaar5', zarho ) 154 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) ) 133 155 zssh_steric = - zarho / area_tot 134 156 CALL iom_put( 'sshthster', zssh_steric ) … … 147 169 DO ji = 1,jpi 148 170 DO jj = 1,jpj 149 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 171 iks = mikt(ji,jj) 172 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,iks) + riceload(ji,jj) 150 173 END DO 151 174 END DO … … 155 178 END IF 156 179 ! 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 CALL mpp_sum( 'diaar5', zarho ) 180 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) ) 159 181 zssh_steric = - zarho / area_tot 160 182 CALL iom_put( 'sshsteric', zssh_steric ) 161 162 183 ! ! ocean bottom pressure 163 184 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa … … 168 189 169 190 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 170 ! ! Mean density anomalie, temperature and salinity171 ztemp = 0._wp172 zsal = 0._wp173 DO jk = 1, jpkm1174 DO jj = 1, jpj175 DO ji = 1, jpi176 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 ENDDO180 ENDDO181 END DO 182 IF( ln_linssh ) THEN191 ! ! Mean density anomalie, temperature and salinity 192 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 193 DO jk = 1, jpkm1 194 DO jj = 1, jpj 195 DO ji = 1, jpi 196 zztmp = area(ji,jj) * e3t_n(ji,jj,jk) 197 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * tsn(ji,jj,jk,jp_tem) 198 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * tsn(ji,jj,jk,jp_sal) 199 ENDDO 200 ENDDO 201 ENDDO 202 203 IF( ln_linssh ) THEN 183 204 IF( ln_isfcav ) THEN 184 205 DO ji = 1, jpi 185 206 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) 207 iks = mikt(ji,jj) 208 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * tsn(ji,jj,iks,jp_tem) 209 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * tsn(ji,jj,iks,jp_sal) 188 210 END DO 189 211 END DO 190 212 ELSE 191 zt emp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )192 z sal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )213 ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * tsn(:,:,1,jp_tem) 214 ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * tsn(:,:,1,jp_sal) 193 215 END IF 194 216 ENDIF 195 IF( lk_mpp ) THEN 196 CALL mpp_sum( 'diaar5', ztemp ) 197 CALL mpp_sum( 'diaar5', 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 217 ! 218 ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) ) 219 zsal = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) ) 220 zmass = rau0 * ( zarho + zvol ) 203 221 ! 204 222 CALL iom_put( 'masstot', zmass ) 205 CALL iom_put( 'temptot', ztemp ) 206 CALL iom_put( 'saltot' , zsal ) 207 ! 223 CALL iom_put( 'temptot', ztemp / zvol ) 224 CALL iom_put( 'saltot' , zsal / zvol ) 225 ! 226 ENDIF 227 228 IF( ln_teos10 ) THEN ! ! potential temperature (TEOS-10 case) 229 IF( iom_use( 'toce_pot') .OR. iom_use( 'temptot_pot' ) .OR. iom_use( 'sst_pot' ) & 230 .OR. iom_use( 'ssttot' ) .OR. iom_use( 'tosmint_pot' ) ) THEN 231 ! 232 ALLOCATE( ztpot(jpi,jpj,jpk) ) 233 ztpot(:,:,jpk) = 0._wp 234 DO jk = 1, jpkm1 235 ztpot(:,:,jk) = eos_pt_from_ct( tsn(:,:,jk,jp_tem), tsn(:,:,jk,jp_sal) ) 236 END DO 237 ! 238 CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case) 239 CALL iom_put( 'sst_pot' , ztpot(:,:,1) ) ! surface temperature 240 ! 241 IF( iom_use( 'temptot_pot' ) ) THEN ! Output potential temperature in case we use TEOS-10 242 z2d(:,:) = 0._wp 243 DO jk = 1, jpkm1 244 z2d(:,:) = z2d(:,:) + area(:,:) * e3t_n(:,:,jk) * ztpot(:,:,jk) 245 END DO 246 ztemp = glob_sum( 'diaar5', z2d(:,:) ) 247 CALL iom_put( 'temptot_pot', ztemp / zvol ) 248 ENDIF 249 ! 250 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 251 zsst = glob_sum( 'diaar5', area(:,:) * ztpot(:,:,1) ) 252 CALL iom_put( 'ssttot', zsst / area_tot ) 253 ENDIF 254 ! Vertical integral of temperature 255 IF( iom_use( 'tosmint_pot') ) THEN 256 z2d(:,:) = 0._wp 257 DO jk = 1, jpkm1 258 DO jj = 1, jpj 259 DO ji = 1, jpi ! vector opt. 260 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * ztpot(ji,jj,jk) 261 END DO 262 END DO 263 END DO 264 CALL iom_put( 'tosmint_pot', z2d ) 265 ENDIF 266 DEALLOCATE( ztpot ) 267 ENDIF 268 ELSE 269 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 270 zsst = glob_sum( 'diaar5', area(:,:) * tsn(:,:,1,jp_tem) ) 271 CALL iom_put('ssttot', zsst / area_tot ) 272 ENDIF 208 273 ENDIF 209 274 210 275 IF( iom_use( 'tnpeo' )) THEN 211 ! Work done against stratification by vertical mixing212 ! Exclude points where rn2 is negative as convection kicks in here and213 ! work is not being done against stratification276 ! Work done against stratification by vertical mixing 277 ! Exclude points where rn2 is negative as convection kicks in here and 278 ! work is not being done against stratification 214 279 ALLOCATE( zpe(jpi,jpj) ) 215 280 zpe(:,:) = 0._wp … … 219 284 DO ji = 1, jpi 220 285 IF( rn2(ji,jj,jk) > 0._wp ) THEN 221 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 222 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 223 !!gm this can be reduced to : (depw-dept) / e3w (NB idem dans bn2 !) 224 ! zrw = ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 225 !!gm end 286 zrw = ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 226 287 ! 227 288 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 228 289 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 229 290 ! 230 zpe(ji, jj) = zpe(ji, jj)&291 zpe(ji, jj) = zpe(ji,jj) & 231 292 & - grav * ( avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 232 293 & - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) … … 239 300 DO ji = 1, jpi 240 301 DO jj = 1, jpj 241 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj,jk)302 zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w_n(ji,jj,jk) 242 303 END DO 243 304 END DO 244 305 END DO 245 306 ENDIF 246 !!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj247 !!gm CALL lbc_lnk( 'diaar5', zpe, 'T', 1._wp)248 307 CALL iom_put( 'tnpeo', zpe ) 249 308 DEALLOCATE( zpe ) … … 251 310 252 311 IF( l_ar5 ) THEN 253 DEALLOCATE( zarea_ssh , zbotpres )312 DEALLOCATE( zarea_ssh , zbotpres, z2d ) 254 313 DEALLOCATE( zrhd , zrhop ) 255 314 DEALLOCATE( ztsn ) … … 287 346 CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 288 347 IF( cptr == 'adv' ) THEN 289 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! advective heat transport in i-direction290 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr", rau0 * z2d ) ! advective salt transport in i-direction348 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rau0_rcp * z2d ) ! advective heat transport in i-direction 349 IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rau0 * z2d ) ! advective salt transport in i-direction 291 350 ENDIF 292 351 IF( cptr == 'ldf' ) THEN 293 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr", rau0_rcp * z2d ) ! diffusive heat transport in i-direction294 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr", rau0 * z2d ) ! diffusive salt transport in i-direction352 IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 353 IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rau0 * z2d ) ! diffusive salt transport in i-direction 295 354 ENDIF 296 355 ! … … 305 364 CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 306 365 IF( cptr == 'adv' ) THEN 307 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! advective heat transport in j-direction308 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr", rau0 * z2d ) ! advective salt transport in j-direction366 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rau0_rcp * z2d ) ! advective heat transport in j-direction 367 IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rau0 * z2d ) ! advective salt transport in j-direction 309 368 ENDIF 310 369 IF( cptr == 'ldf' ) THEN 311 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr", rau0_rcp * z2d ) ! diffusive heat transport in j-direction312 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr", rau0 * z2d ) ! diffusive salt transport in j-direction370 IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 371 IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rau0 * z2d ) ! diffusive salt transport in j-direction 313 372 ENDIF 314 373 … … 323 382 !!---------------------------------------------------------------------- 324 383 INTEGER :: inum 325 INTEGER :: ik 384 INTEGER :: ik, idep 326 385 INTEGER :: ji, jj, jk ! dummy loop indices 327 386 REAL(wp) :: zztmp 328 387 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 388 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zvol0 329 389 ! 330 390 !!---------------------------------------------------------------------- … … 340 400 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 341 401 342 area(:,:) = e1e2t(:,:) * tmask_i(:,:)343 344 area_tot = SUM( area(:,:) ) ; CALL mpp_sum( 'diaar5', area_tot ) 345 346 vol0= 0._wp402 area(:,:) = e1e2t(:,:) 403 area_tot = glob_sum( 'diaar5', area(:,:) ) 404 405 ALLOCATE( zvol0(jpi,jpj) ) 406 zvol0 (:,:) = 0._wp 347 407 thick0(:,:) = 0._wp 348 408 DO jk = 1, jpkm1 349 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 350 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 351 END DO 352 CALL mpp_sum( 'diaar5', vol0 ) 409 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 410 DO ji = 1, jpi 411 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 412 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * area(ji,jj) 413 thick0(ji,jj) = thick0(ji,jj) + idep 414 END DO 415 END DO 416 END DO 417 vol0 = glob_sum( 'diaar5', zvol0 ) 418 DEALLOCATE( zvol0 ) 353 419 354 420 IF( iom_use( 'sshthster' ) ) THEN 355 ALLOCATE( zsaldta(jpi,jpj,jp j,jpts) )421 ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) ) 356 422 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 357 423 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 )
Note: See TracChangeset
for help on using the changeset viewer.
