Changeset 11989 for NEMO/trunk/src/OCE/DIA/diaar5.F90
- Timestamp:
- 2019-11-27T16:13:52+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DIA/diaar5.F90
r10425 r11989 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 ztpot(:,:,:) = eos_pt_from_ct( tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal) ) 235 ! 236 CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case) 237 CALL iom_put( 'sst_pot' , ztpot(:,:,1) ) ! surface temperature 238 ! 239 IF( iom_use( 'temptot_pot' ) ) THEN ! Output potential temperature in case we use TEOS-10 240 z2d(:,:) = 0._wp 241 DO jk = 1, jpkm1 242 z2d(:,:) = z2d(:,:) + area(:,:) * e3t_n(:,:,jk) * ztpot(:,:,jk) 243 END DO 244 ztemp = glob_sum( 'diaar5', z2d(:,:) ) 245 CALL iom_put( 'temptot_pot', ztemp / zvol ) 246 ENDIF 247 ! 248 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 249 zsst = glob_sum( 'diaar5', area(:,:) * ztpot(:,:,1) ) 250 CALL iom_put( 'ssttot', zsst / area_tot ) 251 ENDIF 252 ! Vertical integral of temperature 253 IF( iom_use( 'tosmint_pot') ) THEN 254 z2d(:,:) = 0._wp 255 DO jk = 1, jpkm1 256 DO jj = 1, jpj 257 DO ji = 1, jpi ! vector opt. 258 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t_n(ji,jj,jk) * ztpot(ji,jj,jk) 259 END DO 260 END DO 261 END DO 262 CALL iom_put( 'tosmint_pot', z2d ) 263 ENDIF 264 DEALLOCATE( ztpot ) 265 ENDIF 266 ELSE 267 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 268 zsst = glob_sum( 'diaar5', area(:,:) * tsn(:,:,1,jp_tem) ) 269 CALL iom_put('ssttot', zsst / area_tot ) 270 ENDIF 208 271 ENDIF 209 272 210 273 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 stratification274 ! Work done against stratification by vertical mixing 275 ! Exclude points where rn2 is negative as convection kicks in here and 276 ! work is not being done against stratification 214 277 ALLOCATE( zpe(jpi,jpj) ) 215 278 zpe(:,:) = 0._wp … … 219 282 DO ji = 1, jpi 220 283 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 284 zrw = ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 226 285 ! 227 286 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 228 287 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 229 288 ! 230 zpe(ji, jj) = zpe(ji, jj)&289 zpe(ji, jj) = zpe(ji,jj) & 231 290 & - grav * ( avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 232 291 & - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) … … 239 298 DO ji = 1, jpi 240 299 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)300 zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w_n(ji,jj,jk) 242 301 END DO 243 302 END DO 244 303 END DO 245 304 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 305 CALL iom_put( 'tnpeo', zpe ) 249 306 DEALLOCATE( zpe ) … … 251 308 252 309 IF( l_ar5 ) THEN 253 DEALLOCATE( zarea_ssh , zbotpres )310 DEALLOCATE( zarea_ssh , zbotpres, z2d ) 254 311 DEALLOCATE( zrhd , zrhop ) 255 312 DEALLOCATE( ztsn ) … … 287 344 CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 288 345 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-direction346 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rau0_rcp * z2d ) ! advective heat transport in i-direction 347 IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rau0 * z2d ) ! advective salt transport in i-direction 291 348 ENDIF 292 349 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-direction350 IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 351 IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rau0 * z2d ) ! diffusive salt transport in i-direction 295 352 ENDIF 296 353 ! … … 305 362 CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 306 363 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-direction364 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rau0_rcp * z2d ) ! advective heat transport in j-direction 365 IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rau0 * z2d ) ! advective salt transport in j-direction 309 366 ENDIF 310 367 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-direction368 IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 369 IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rau0 * z2d ) ! diffusive salt transport in j-direction 313 370 ENDIF 314 371 … … 323 380 !!---------------------------------------------------------------------- 324 381 INTEGER :: inum 325 INTEGER :: ik 382 INTEGER :: ik, idep 326 383 INTEGER :: ji, jj, jk ! dummy loop indices 327 384 REAL(wp) :: zztmp 328 385 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 386 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zvol0 329 387 ! 330 388 !!---------------------------------------------------------------------- … … 340 398 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 341 399 342 area(:,:) = e1e2t(:,:) * tmask_i(:,:)343 344 area_tot = SUM( area(:,:) ) ; CALL mpp_sum( 'diaar5', area_tot ) 345 346 vol0= 0._wp400 area(:,:) = e1e2t(:,:) 401 area_tot = glob_sum( 'diaar5', area(:,:) ) 402 403 ALLOCATE( zvol0(jpi,jpj) ) 404 zvol0 (:,:) = 0._wp 347 405 thick0(:,:) = 0._wp 348 406 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 ) 407 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 408 DO ji = 1, jpi 409 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 410 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * area(ji,jj) 411 thick0(ji,jj) = thick0(ji,jj) + idep 412 END DO 413 END DO 414 END DO 415 vol0 = glob_sum( 'diaar5', zvol0 ) 416 DEALLOCATE( zvol0 ) 353 417 354 418 IF( iom_use( 'sshthster' ) ) THEN 355 ALLOCATE( zsaldta(jpi,jpj,jp j,jpts) )419 ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) ) 356 420 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 357 421 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 )
Note: See TracChangeset
for help on using the changeset viewer.