Changeset 7923 for branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
- Timestamp:
- 2017-04-18T15:26:56+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6793 r7923 24 24 USE phycst ! physical constant 25 25 USE in_out_manager ! I/O manager 26 USE zdfddm 27 USE zdf_oce 26 28 27 29 IMPLICIT NONE … … 42 44 !! * Substitutions 43 45 # include "domzgr_substitute.h90" 46 # include "zdfddm_substitute.h90" 44 47 !!---------------------------------------------------------------------- 45 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 75 78 INTEGER :: ji, jj, jk ! dummy loop arguments 76 79 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 80 REAL(wp) :: zaw, zbw, zrw 77 81 ! 78 82 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 83 REAL(wp), POINTER, DIMENSION(:,:) :: pe ! 2D workspace 79 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 80 85 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 86 !!-------------------------------------------------------------------- 82 87 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') 88 89 !Call to init moved to here so that we can call iom_use in the 90 !initialisation 91 IF( kt == nit000 ) CALL dia_ar5_init 83 92 84 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres )93 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres, pe ) 85 94 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 86 95 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) … … 95 104 CALL iom_put( 'voltot', zvol ) 96 105 CALL iom_put( 'sshtot', zvolssh / area_tot ) 106 CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 97 107 98 108 ! 99 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 100 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 101 CALL eos( ztsn, zrhd, fsdept_n(:,:,:) ) ! now in situ density using initial salinity 102 ! 103 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 104 DO jk = 1, jpkm1 105 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 106 END DO 107 IF( .NOT.lk_vvl ) THEN 108 IF ( ln_isfcav ) THEN 109 DO ji=1,jpi 110 DO jj=1,jpj 111 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 109 IF( iom_use('sshthster')) THEN 110 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 111 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 112 CALL eos( ztsn, zrhd, fsdept_n(:,:,:) ) ! now in situ density using initial salinity 113 ! 114 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 115 DO jk = 1, jpkm1 116 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 117 END DO 118 IF( .NOT.lk_vvl ) THEN 119 IF ( ln_isfcav ) THEN 120 DO ji=1,jpi 121 DO jj=1,jpj 122 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 123 END DO 112 124 END DO 113 E ND DO114 ELSE115 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)125 ELSE 126 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 127 END IF 116 128 END IF 117 END IF118 129 ! 119 zarho = SUM( area(:,:) * zbotpres(:,:) ) 120 IF( lk_mpp ) CALL mpp_sum( zarho ) 121 zssh_steric = - zarho / area_tot 122 CALL iom_put( 'sshthster', zssh_steric ) 130 zarho = SUM( area(:,:) * zbotpres(:,:) ) 131 IF( lk_mpp ) CALL mpp_sum( zarho ) 132 zssh_steric = - zarho / area_tot 133 CALL iom_put( 'sshthster', zssh_steric ) 134 ENDIF 123 135 124 136 ! ! steric sea surface height … … 190 202 CALL iom_put( 'temptot', ztemp ) 191 203 CALL iom_put( 'saltot' , zsal ) 192 ! 193 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 204 205 IF( iom_use( 'tnpeo' )) THEN 206 ! Work done against stratification by vertical mixing 207 ! Exclude points where rn2 is negative as convection kicks in here and 208 ! work is not being done against stratification 209 pe(:,:) = 0._wp 210 IF( lk_zdfddm ) THEN 211 DO ji=1,jpi 212 DO jj=1,jpj 213 DO jk=1,jpk 214 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 215 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 216 ! 217 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 218 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 219 ! 220 pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 221 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 222 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 223 224 ENDDO 225 ENDDO 226 ENDDO 227 ELSE 228 DO ji=1,jpi 229 DO jj=1,jpj 230 DO jk=1,jpk 231 pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 232 ENDDO 233 ENDDO 234 ENDDO 235 ENDIF 236 CALL iom_put( 'tnpeo', pe ) 237 ENDIF 238 ! 239 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres, pe ) 194 240 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 195 241 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) … … 232 278 IF( lk_mpp ) CALL mpp_sum( vol0 ) 233 279 234 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 235 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 236 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 237 CALL iom_close( inum ) 238 239 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 240 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 241 IF( ln_zps ) THEN ! z-coord. partial steps 242 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 243 DO ji = 1, jpi 244 ik = mbkt(ji,jj) 245 IF( ik > 1 ) THEN 246 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 247 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 248 ENDIF 280 IF( iom_use('sshthster')) THEN 281 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 282 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 283 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 284 CALL iom_close( inum ) 285 286 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 287 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 288 IF( ln_zps ) THEN ! z-coord. partial steps 289 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 290 DO ji = 1, jpi 291 ik = mbkt(ji,jj) 292 IF( ik > 1 ) THEN 293 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 294 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 295 ENDIF 296 END DO 249 297 END DO 250 END DO298 ENDIF 251 299 ENDIF 252 300 !
Note: See TracChangeset
for help on using the changeset viewer.
