- Timestamp:
- 2016-11-03T16:39:56+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6793 r7179 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 … … 82 87 IF( nn_timing == 1 ) CALL timing_start('dia_ar5') 83 88 84 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres )89 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres, pe ) 85 90 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 86 91 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) … … 95 100 CALL iom_put( 'voltot', zvol ) 96 101 CALL iom_put( 'sshtot', zvolssh / area_tot ) 102 CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 97 103 98 104 ! 105 IF( iom_use('sshthster') ) THEN 99 106 ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) ! thermosteric ssh 100 107 ztsn(:,:,:,jp_sal) = sn0(:,:,:) … … 116 123 END IF 117 124 END IF 125 ENDIF 118 126 ! 119 127 zarho = SUM( area(:,:) * zbotpres(:,:) ) … … 190 198 CALL iom_put( 'temptot', ztemp ) 191 199 CALL iom_put( 'saltot' , zsal ) 192 ! 193 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres ) 200 201 IF( iom_use( 'tnpeo' )) THEN 202 ! Work done against stratification by vertical mixing 203 ! Exclude points where rn2 is negative as convection kicks in here and 204 ! work is not being done against stratification 205 pe(:,:) = 0._wp 206 IF( lk_zdfddm ) THEN 207 DO ji=1,jpi 208 DO jj=1,jpj 209 DO jk=1,jpk 210 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 211 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 212 ! 213 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 214 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 215 ! 216 pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 217 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 218 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 219 220 ENDDO 221 ENDDO 222 ENDDO 223 ELSE 224 DO ji=1,jpi 225 DO jj=1,jpj 226 DO jk=1,jpk 227 pe(ji,jj) = pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 228 ENDDO 229 ENDDO 230 ENDDO 231 ENDIF 232 CALL iom_put( 'tnpeo', pe ) 233 ENDIF 234 ! 235 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres, pe ) 194 236 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 195 237 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) … … 232 274 IF( lk_mpp ) CALL mpp_sum( vol0 ) 233 275 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 )276 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 277 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 278 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 279 CALL iom_close( inum ) 238 280 239 281 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )
Note: See TracChangeset
for help on using the changeset viewer.