- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r9816 r9817 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 ) … … 211 257 REAL(wp) :: zztmp 212 258 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 213 ! reading initial file214 LOGICAL :: ln_tsd_init !: T & S data flag215 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag216 CHARACTER(len=100) :: cn_dir217 TYPE(FLD_N) :: sn_tem,sn_sal218 INTEGER :: ios=0219 220 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal221 !222 223 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :224 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)225 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )226 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run227 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )228 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )229 IF(lwm) WRITE ( numond, namtsd )230 259 ! 231 260 !!---------------------------------------------------------------------- … … 233 262 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 234 263 ! 235 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )264 CALL wrk_alloc( jpi, jpj, jpk, 2, zsaldta ) 236 265 ! ! allocate dia_ar5 arrays 237 266 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 249 278 IF( lk_mpp ) CALL mpp_sum( vol0 ) 250 279 251 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum ) 252 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 ) 253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 254 CALL iom_close( inum ) 255 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 256 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 257 IF( ln_zps ) THEN ! z-coord. partial steps 258 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 259 DO ji = 1, jpi 260 ik = mbkt(ji,jj) 261 IF( ik > 1 ) THEN 262 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 263 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 264 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 265 297 END DO 266 END DO298 ENDIF 267 299 ENDIF 268 300 ! 269 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )301 CALL wrk_dealloc( jpi, jpj, jpk, 2, zsaldta ) 270 302 ! 271 303 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init')
Note: See TracChangeset
for help on using the changeset viewer.
