Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
- Property svn:eol-style deleted
r1585 r2528 11 11 !! NEMO 3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning + add new diag 12 12 !!---------------------------------------------------------------------- 13 14 13 #if defined key_diahth || defined key_esopa 15 14 !!---------------------------------------------------------------------- … … 18 17 !! dia_hth : Compute varius diagnostics associated with the mixed layer 19 18 !!---------------------------------------------------------------------- 20 !! * Modules used21 19 USE oce ! ocean dynamics and tracers 22 20 USE dom_oce ! ocean space and time domain 23 21 USE phycst ! physical constants 24 22 USE in_out_manager ! I/O manager 25 USE iom 23 USE iom ! I/O library 26 24 27 25 IMPLICIT NONE 28 26 PRIVATE 29 27 30 !! * Routine accessibility 31 PUBLIC dia_hth ! routine called by step.F90 32 33 !! * Shared module variables 28 PUBLIC dia_hth ! routine called by step.F90 29 34 30 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE. !: thermocline-20d depths flag 35 31 ! note: following variables should move to local variables once iom_put is always used … … 42 38 # include "domzgr_substitute.h90" 43 39 !!---------------------------------------------------------------------- 44 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 45 41 !! $Id$ 46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 47 !!---------------------------------------------------------------------- 48 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 49 44 CONTAINS 50 45 … … 68 63 !! 69 64 !! ** Method : 70 !!71 65 !!------------------------------------------------------------------- 72 66 INTEGER, INTENT( in ) :: kt ! ocean time-step index 73 67 !! 74 68 INTEGER :: ji, jj, jk ! dummy loop arguments 75 INTEGER :: iid, i if, ilevel! temporary integers69 INTEGER :: iid, ilevel ! temporary integers 76 70 INTEGER, DIMENSION(jpi,jpj) :: ik20, ik28 ! levels 77 71 REAL(wp) :: zavt5 = 5.e-4_wp ! Kz criterion for the turbocline depth … … 103 97 104 98 ! initialization 105 ztinv (:,:) = 0. e0_wp106 zdepinv(:,:) = 0. e0_wp107 zmaxdzT(:,:) = 0. e0_wp99 ztinv (:,:) = 0._wp 100 zdepinv(:,:) = 0._wp 101 zmaxdzT(:,:) = 0._wp 108 102 DO jj = 1, jpj 109 103 DO ji = 1, jpi … … 128 122 ! Preliminary computation 129 123 ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) 130 DO jj =1, jpj131 DO ji =1, jpi124 DO jj = 1, jpj 125 DO ji = 1, jpi 132 126 IF( tmask(ji,jj,nla10) == 1. ) THEN 133 127 zu = 1779.50 + 11.250*tn(ji,jj,nla10) - 3.80*sn(ji,jj,nla10) - 0.0745*tn(ji,jj,nla10)*tn(ji,jj,nla10) & … … 139 133 zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 140 134 ELSE 141 zdelr(ji,jj) = 0. e0135 zdelr(ji,jj) = 0._wp 142 136 ENDIF 143 137 END DO … … 153 147 DO jj = 1, jpj 154 148 DO ji = 1, jpi 155 149 ! 156 150 zzdep = fsdepw(ji,jj,jk) 157 151 zztmp = ( tn(ji,jj,jk-1) - tn(ji,jj,jk) ) / zzdep * tmask(ji,jj,jk) ! vertical gradient of temperature (dT/dz) … … 189 183 DO jj = 1, jpj 190 184 DO ji = 1, jpi 191 185 ! 192 186 zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1) 193 187 ! 194 188 zztmp = tn(ji,jj,nla10) - tn(ji,jj,jk) ! - delta T(10m) 195 189 IF( ABS(zztmp) > ztem2 ) zabs2 (ji,jj) = zzdep ! abs > 0.2 … … 203 197 IF( zztmp > zrho3 ) zrho10_3(ji,jj) = zzdep ! > 0.03 204 198 IF( zztmp > zdelr(ji,jj) ) zpycn (ji,jj) = zzdep ! > equi. delta T(10m) - 0.2 205 199 ! 206 200 END DO 207 201 END DO … … 237 231 DO jj = 1, jpj 238 232 DO ji = 1, jpi 239 240 iif = mbathy(ji,jj) 241 zzdep = fsdepw(ji,jj,iif) 242 233 ! 234 zzdep = fsdepw(ji,jj,mbkt(ji,jj)+1) ! depth of the oean bottom 235 ! 243 236 iid = ik20(ji,jj) 244 237 IF( iid /= 1 ) THEN 245 ! linear interpolation 246 zztmp = fsdept(ji,jj,iid ) & 238 zztmp = fsdept(ji,jj,iid ) & ! linear interpolation 247 239 & + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & 248 240 & * ( 20.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & 249 241 & / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) ) 250 ! bound by the ocean depth, minimum value, first T-point depth 251 hd20(ji,jj) = MIN( zztmp*tmask(ji,jj,1), zzdep) 242 hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1) ! bound by the ocean depth 252 243 ELSE 253 hd20(ji,jj) =0.244 hd20(ji,jj) = 0._wp 254 245 ENDIF 255 246 ! 256 247 iid = ik28(ji,jj) 257 248 IF( iid /= 1 ) THEN 258 ! linear interpolation 259 zztmp = fsdept(ji,jj,iid ) & 249 zztmp = fsdept(ji,jj,iid ) & ! linear interpolation 260 250 & + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & 261 251 & * ( 28.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & 262 252 & / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) ) 263 ! bound by the ocean depth, minimum value, first T-point depth 264 hd28(ji,jj) = MIN( zztmp*tmask(ji,jj,1), zzdep ) 253 hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1) ! bound by the ocean depth 265 254 ELSE 266 hd28(ji,jj) = 0. 255 hd28(ji,jj) = 0._wp 267 256 ENDIF 268 257 … … 277 266 278 267 ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_0 to do this search...) 279 ilevel = 0280 zthick_0 = 0. e0_wp268 ilevel = 0 269 zthick_0 = 0._wp 281 270 DO jk = 1, jpkm1 282 271 zthick_0 = zthick_0 + e3t_0(jk) … … 284 273 END DO 285 274 ! surface boundary condition 286 IF( lk_vvl ) THEN ; zthick(:,:) = 0. e0_wp ; htc3(:,:) = 0.e0_wp275 IF( lk_vvl ) THEN ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp 287 276 ELSE ; zthick(:,:) = sshn(:,:) ; htc3(:,:) = tn(:,:,jk) * sshn(:,:) * tmask(:,:,jk) 288 277 ENDIF … … 303 292 htc3(:,:) = zcoef * htc3(:,:) 304 293 CALL iom_put( "hc300", htc3 ) ! first 300m heat content 305 306 294 ! 307 295 END SUBROUTINE dia_hth 308 296
Note: See TracChangeset
for help on using the changeset viewer.
