- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
OCE/DIA/diaar5.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diaar5.F90
r10425 r11949 62 62 63 63 64 SUBROUTINE dia_ar5( kt )64 SUBROUTINE dia_ar5( kt, Kmm ) 65 65 !!---------------------------------------------------------------------- 66 66 !! *** ROUTINE dia_ar5 *** … … 70 70 ! 71 71 INTEGER, INTENT( in ) :: kt ! ocean time-step index 72 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 72 73 ! 73 74 INTEGER :: ji, jj, jk ! dummy loop arguments … … 89 90 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 90 91 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 91 zarea_ssh(:,:) = area(:,:) * ssh n(:,:)92 zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm) 92 93 ENDIF 93 94 ! … … 100 101 CALL iom_put( 'voltot', zvol ) 101 102 CALL iom_put( 'sshtot', zvolssh / area_tot ) 102 CALL iom_put( 'sshdyn', ssh n(:,:) - (zvolssh / area_tot) )103 CALL iom_put( 'sshdyn', ssh(:,:,Kmm) - (zvolssh / area_tot) ) 103 104 ! 104 105 ENDIF … … 106 107 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 107 108 ! 108 ztsn(:,:,:,jp_tem) = ts n(:,:,:,jp_tem) ! thermosteric ssh109 ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm) ! thermosteric ssh 109 110 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 110 CALL eos( ztsn, zrhd, gdept _n(:,:,:) ) ! now in situ density using initial salinity111 CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) ) ! now in situ density using initial salinity 111 112 ! 112 113 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 113 114 DO jk = 1, jpkm1 114 zbotpres(:,:) = zbotpres(:,:) + e3t _n(:,:,jk) * zrhd(:,:,jk)115 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 115 116 END DO 116 117 IF( ln_linssh ) THEN … … 118 119 DO ji = 1, jpi 119 120 DO jj = 1, jpj 120 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh n(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)121 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 121 122 END DO 122 123 END DO 123 124 ELSE 124 zbotpres(:,:) = zbotpres(:,:) + ssh n(:,:) * zrhd(:,:,1)125 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 125 126 END IF 126 127 !!gm … … 135 136 136 137 ! ! steric sea surface height 137 CALL eos( ts n, zrhd, zrhop, gdept_n(:,:,:) ) ! now in situ and potential density138 CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) ) ! now in situ and potential density 138 139 zrhop(:,:,jpk) = 0._wp 139 140 CALL iom_put( 'rhop', zrhop ) … … 141 142 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 142 143 DO jk = 1, jpkm1 143 zbotpres(:,:) = zbotpres(:,:) + e3t _n(:,:,jk) * zrhd(:,:,jk)144 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk) 144 145 END DO 145 146 IF( ln_linssh ) THEN … … 147 148 DO ji = 1,jpi 148 149 DO jj = 1,jpj 149 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh n(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj)150 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 150 151 END DO 151 152 END DO 152 153 ELSE 153 zbotpres(:,:) = zbotpres(:,:) + ssh n(:,:) * zrhd(:,:,1)154 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) 154 155 END IF 155 156 END IF … … 162 163 ! ! ocean bottom pressure 163 164 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 164 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh n(:,:) + thick0(:,:) )165 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + ssh(:,:,Kmm) + thick0(:,:) ) 165 166 CALL iom_put( 'botpres', zbotpres ) 166 167 ! … … 174 175 DO jj = 1, jpj 175 176 DO ji = 1, jpi 176 zztmp = area(ji,jj) * e3t _n(ji,jj,jk)177 ztemp = ztemp + zztmp * ts n(ji,jj,jk,jp_tem)178 zsal = zsal + zztmp * ts n(ji,jj,jk,jp_sal)177 zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 178 ztemp = ztemp + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 179 zsal = zsal + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 179 180 END DO 180 181 END DO … … 184 185 DO ji = 1, jpi 185 186 DO jj = 1, jpj 186 ztemp = ztemp + zarea_ssh(ji,jj) * ts n(ji,jj,mikt(ji,jj),jp_tem)187 zsal = zsal + zarea_ssh(ji,jj) * ts n(ji,jj,mikt(ji,jj),jp_sal)187 ztemp = ztemp + zarea_ssh(ji,jj) * ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) 188 zsal = zsal + zarea_ssh(ji,jj) * ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) 188 189 END DO 189 190 END DO 190 191 ELSE 191 ztemp = ztemp + SUM( zarea_ssh(:,:) * ts n(:,:,1,jp_tem) )192 zsal = zsal + SUM( zarea_ssh(:,:) * ts n(:,:,1,jp_sal) )192 ztemp = ztemp + SUM( zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) ) 193 zsal = zsal + SUM( zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) ) 193 194 END IF 194 195 ENDIF … … 219 220 DO ji = 1, jpi 220 221 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) )222 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 223 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 223 224 !!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 ! zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 225 226 !!gm end 226 227 ! … … 229 230 ! 230 231 zpe(ji, jj) = zpe(ji, jj) & 231 & - grav * ( avt(ji,jj,jk) * zaw * (ts n(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) &232 & - avs(ji,jj,jk) * zbw * (ts n(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) )232 & - grav * ( avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & 233 & - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) 233 234 ENDIF 234 235 END DO … … 239 240 DO ji = 1, jpi 240 241 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)242 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w(ji, jj, jk,Kmm) 242 243 END DO 243 244 END DO … … 261 262 262 263 263 SUBROUTINE dia_ar5_hst( ktra, cptr, pu a, pva)264 SUBROUTINE dia_ar5_hst( ktra, cptr, puflx, pvflx ) 264 265 !!---------------------------------------------------------------------- 265 266 !! *** ROUTINE dia_ar5_htr *** … … 270 271 INTEGER , INTENT(in ) :: ktra ! tracer index 271 272 CHARACTER(len=3) , INTENT(in) :: cptr ! transport type 'adv'/'ldf' 272 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pu a ! 3D input arrayof advection/diffusion273 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pv a ! 3D input arrayof advection/diffusion273 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: puflx ! u-flux of advection/diffusion 274 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pvflx ! v-flux of advection/diffusion 274 275 ! 275 276 INTEGER :: ji, jj, jk … … 277 278 278 279 279 z2d(:,:) = pu a(:,:,1)280 z2d(:,:) = puflx(:,:,1) 280 281 DO jk = 1, jpkm1 281 282 DO jj = 2, jpjm1 282 283 DO ji = fs_2, fs_jpim1 ! vector opt. 283 z2d(ji,jj) = z2d(ji,jj) + pu a(ji,jj,jk)284 z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk) 284 285 END DO 285 286 END DO … … 295 296 ENDIF 296 297 ! 297 z2d(:,:) = pv a(:,:,1)298 z2d(:,:) = pvflx(:,:,1) 298 299 DO jk = 1, jpkm1 299 300 DO jj = 2, jpjm1 300 301 DO ji = fs_2, fs_jpim1 ! vector opt. 301 z2d(ji,jj) = z2d(ji,jj) + pv a(ji,jj,jk)302 z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk) 302 303 END DO 303 304 END DO
Note: See TracChangeset
for help on using the changeset viewer.
