Changeset 11993 for NEMO/trunk/src/OCE/DIA/diaar5.F90
- Timestamp:
- 2019-11-28T11:20:53+01:00 (5 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/DIA/diaar5.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DIA/diaar5.F90
r11989 r11993 71 71 INTEGER, INTENT( in ) :: kt ! ocean time-step index 72 72 ! 73 INTEGER :: ji, jj, jk , iks, ikb! dummy loop arguments74 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass , zsst73 INTEGER :: ji, jj, jk ! dummy loop arguments 74 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 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 , z2d! 2D workspace79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop , ztpot! 3D workspace78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe ! 2D workspace 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop ! 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), z2d(jpi,jpj) )88 ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(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' ) ) THEN99 zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace100 DO jk = 1, jpkm1101 zrhd(:,:,jk) = area(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk)102 END DO103 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000104 CALL iom_put( 'masscello' , rau0 * e3t_n(:,:,:) * tmask(:,:,:) ) ! ocean mass105 ENDIF106 !107 IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness108 DO jj = 1, jpj109 DO ji = 1, jpi110 ikb = mbkt(ji,jj)111 z2d(ji,jj) = e3t_n(ji,jj,ikb)112 END DO113 END DO114 CALL iom_put( 'e3tb', z2d )115 ENDIF116 !117 94 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 118 95 ! ! total volume of liquid seawater 119 zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 120 zvol = vol0 + zvolssh 96 zvolssh = SUM( zarea_ssh(:,:) ) 97 CALL mpp_sum( 'diaar5', zvolssh ) 98 zvol = vol0 + zvolssh 121 99 122 100 CALL iom_put( 'voltot', zvol ) … … 140 118 DO ji = 1, jpi 141 119 DO jj = 1, jpj 142 iks = mikt(ji,jj) 143 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,iks) + riceload(ji,jj) 120 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 144 121 END DO 145 122 END DO … … 152 129 END IF 153 130 ! 154 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) ) 131 zarho = SUM( area(:,:) * zbotpres(:,:) ) 132 CALL mpp_sum( 'diaar5', zarho ) 155 133 zssh_steric = - zarho / area_tot 156 134 CALL iom_put( 'sshthster', zssh_steric ) … … 169 147 DO ji = 1,jpi 170 148 DO jj = 1,jpj 171 iks = mikt(ji,jj) 172 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,iks) + riceload(ji,jj) 149 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 173 150 END DO 174 151 END DO … … 178 155 END IF 179 156 ! 180 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) ) 157 zarho = SUM( area(:,:) * zbotpres(:,:) ) 158 CALL mpp_sum( 'diaar5', zarho ) 181 159 zssh_steric = - zarho / area_tot 182 160 CALL iom_put( 'sshsteric', zssh_steric ) 161 183 162 ! ! ocean bottom pressure 184 163 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa … … 189 168 190 169 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 191 192 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity193 DO jk = 1, jpkm1194 DO jj = 1, jpj195 DO ji = 1, jpi196 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 ENDDO200 ENDDO201 ENDDO202 203 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 204 183 IF( ln_isfcav ) THEN 205 184 DO ji = 1, jpi 206 185 DO jj = 1, jpj 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) 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) 210 188 END DO 211 189 END DO 212 190 ELSE 213 zt sn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * tsn(:,:,1,jp_tem)214 z tsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * tsn(:,:,1,jp_sal)191 ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 192 zsal = zsal + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 215 193 END IF 216 194 ENDIF 217 ! 218 ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) ) 219 zsal = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) ) 220 zmass = rau0 * ( zarho + zvol ) 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 221 203 ! 222 204 CALL iom_put( 'masstot', zmass ) 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 205 CALL iom_put( 'temptot', ztemp ) 206 CALL iom_put( 'saltot' , zsal ) 207 ! 271 208 ENDIF 272 209 273 210 IF( iom_use( 'tnpeo' )) THEN 274 275 276 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 277 214 ALLOCATE( zpe(jpi,jpj) ) 278 215 zpe(:,:) = 0._wp … … 282 219 DO ji = 1, jpi 283 220 IF( rn2(ji,jj,jk) > 0._wp ) THEN 284 zrw = ( gdept_n(ji,jj,jk) - gdepw_n(ji,jj,jk) ) / e3w_n(ji,jj,jk) 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 285 226 ! 286 227 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 287 228 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 288 229 ! 289 zpe(ji, jj) = zpe(ji, jj)&230 zpe(ji, jj) = zpe(ji, jj) & 290 231 & - grav * ( avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 291 232 & - avs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) … … 298 239 DO ji = 1, jpi 299 240 DO jj = 1, jpj 300 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w_n(ji,jj,jk)241 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w_n(ji, jj, jk) 301 242 END DO 302 243 END DO 303 244 END DO 304 245 ENDIF 246 !!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj 247 !!gm CALL lbc_lnk( 'diaar5', zpe, 'T', 1._wp) 305 248 CALL iom_put( 'tnpeo', zpe ) 306 249 DEALLOCATE( zpe ) … … 308 251 309 252 IF( l_ar5 ) THEN 310 DEALLOCATE( zarea_ssh , zbotpres , z2d)253 DEALLOCATE( zarea_ssh , zbotpres ) 311 254 DEALLOCATE( zrhd , zrhop ) 312 255 DEALLOCATE( ztsn ) … … 344 287 CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 345 288 IF( cptr == 'adv' ) THEN 346 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr', rau0_rcp * z2d ) ! advective heat transport in i-direction347 IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr', rau0 * z2d ) ! advective salt transport in i-direction289 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in i-direction 290 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr" , rau0 * z2d ) ! advective salt transport in i-direction 348 291 ENDIF 349 292 IF( cptr == 'ldf' ) THEN 350 IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr', rau0_rcp * z2d ) ! diffusive heat transport in i-direction351 IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr', rau0 * z2d ) ! diffusive salt transport in i-direction293 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 294 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr" , rau0 * z2d ) ! diffusive salt transport in i-direction 352 295 ENDIF 353 296 ! … … 362 305 CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 363 306 IF( cptr == 'adv' ) THEN 364 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr', rau0_rcp * z2d ) ! advective heat transport in j-direction365 IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr', rau0 * z2d ) ! advective salt transport in j-direction307 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr" , rau0_rcp * z2d ) ! advective heat transport in j-direction 308 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr" , rau0 * z2d ) ! advective salt transport in j-direction 366 309 ENDIF 367 310 IF( cptr == 'ldf' ) THEN 368 IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr', rau0_rcp * z2d ) ! diffusive heat transport in j-direction369 IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr', rau0 * z2d ) ! diffusive salt transport in j-direction311 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr" , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 312 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr" , rau0 * z2d ) ! diffusive salt transport in j-direction 370 313 ENDIF 371 314 … … 380 323 !!---------------------------------------------------------------------- 381 324 INTEGER :: inum 382 INTEGER :: ik , idep325 INTEGER :: ik 383 326 INTEGER :: ji, jj, jk ! dummy loop indices 384 327 REAL(wp) :: zztmp 385 328 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 386 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zvol0387 329 ! 388 330 !!---------------------------------------------------------------------- … … 398 340 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 399 341 400 area(:,:) = e1e2t(:,:) 401 area_tot = glob_sum( 'diaar5', area(:,:) ) 402 403 ALLOCATE( zvol0(jpi,jpj) ) 404 zvol0 (:,:)= 0._wp342 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 343 344 area_tot = SUM( area(:,:) ) ; CALL mpp_sum( 'diaar5', area_tot ) 345 346 vol0 = 0._wp 405 347 thick0(:,:) = 0._wp 406 348 DO jk = 1, jpkm1 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 ) 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 ) 417 353 418 354 IF( iom_use( 'sshthster' ) ) THEN 419 ALLOCATE( zsaldta(jpi,jpj,jp k,jpts) )355 ALLOCATE( zsaldta(jpi,jpj,jpj,jpts) ) 420 356 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 421 357 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 )
Note: See TracChangeset
for help on using the changeset viewer.
