- Timestamp:
- 2011-12-11T16:00:26+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r2715 r3211 53 53 INTEGER :: ionce, icount 54 54 55 !! * Control permutation of array indices 56 # include "oce_ftrans.h90" 57 # include "dom_oce_ftrans.h90" 58 # include "trdmld_oce_ftrans.h90" 59 # include "ldftra_oce_ftrans.h90" 60 # include "zdf_oce_ftrans.h90" 61 # include "ldfslp_ftrans.h90" 62 # include "zdfddm_ftrans.h90" 63 55 64 !! * Substitutions 56 65 # include "domzgr_substitute.h90" … … 98 107 INTEGER , INTENT( in ) :: ktrd ! ocean trend index 99 108 CHARACTER(len=2) , INTENT( in ) :: ctype ! 2D surface/bottom or 3D interior physics 100 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmld ! temperature trend 101 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmld ! salinity trend 109 110 !! DCSE_NEMO: This style defeats ftrans 111 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pttrdmld ! temperature trend 112 ! REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pstrdmld ! salinity trend 113 114 !FTRANS pttrdmld pstrdmld :I :I :z 115 REAL(wp), INTENT( in ) :: pttrdmld(jpi,jpj,jpk) ! temperature trend 116 REAL(wp), INTENT( in ) :: pstrdmld(jpi,jpj,jpk) ! salinity trend 102 117 ! 103 118 INTEGER :: ji, jj, jk, isum … … 160 175 ! ... Weights for vertical averaging 161 176 wkx(:,:,:) = 0.e0 177 #if defined key_z_first 178 DO jj = 1,jpj ! initialize wkx with vertical scale factor in mixed-layer 179 DO ji = 1,jpi 180 DO jk = 1, jpktrd 181 IF( jk < nmld(ji,jj) ) wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 182 #else 162 183 DO jk = 1, jpktrd ! initialize wkx with vertical scale factor in mixed-layer 163 184 DO jj = 1,jpj 164 185 DO ji = 1,jpi 165 186 IF( jk - nmld(ji,jj) < 0.e0 ) wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 187 #endif 166 188 END DO 167 189 END DO … … 169 191 170 192 rmld(:,:) = 0.e0 ! compute mixed-layer depth : rmld 193 #if defined key_z_first 194 DO jj = 1, jpj 195 DO ji = 1, jpi 196 DO jk = 1, jpktrd 197 rmld(ji,jj) = rmld(ji,jj) + wkx(ji,jj,jk) 198 END DO 199 END DO 200 END DO 201 #else 171 202 DO jk = 1, jpktrd 172 203 rmld(:,:) = rmld(:,:) + wkx(:,:,jk) 173 204 END DO 174 205 #endif 206 207 #if defined key_z_first 208 DO jj = 1, jpj 209 DO ji = 1, jpi 210 DO jk = 1, jpktrd ! compute integration weights 211 wkx(ji,jj,jk) = wkx(ji,jj,jk) / MAX( 1., rmld(ji,jj) ) 212 END DO 213 END DO 214 END DO 215 #else 175 216 DO jk = 1, jpktrd ! compute integration weights 176 217 wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1., rmld(:,:) ) 177 218 END DO 219 #endif 178 220 179 221 icount = 0 ! <<< flag = off : control surface & integr. weights … … 186 228 SELECT CASE (ctype) 187 229 CASE ( '3D' ) ! mean T/S trends in the mixed-layer 230 #if defined key_z_first 231 DO jj = 1, jpj 232 DO ji = 1, jpi 233 DO jk = 1, jpktrd 234 tmltrd(ji,jj,ktrd) = tmltrd(ji,jj,ktrd) + pttrdmld(ji,jj,jk) * wkx(ji,jj,jk) ! temperature 235 smltrd(ji,jj,ktrd) = smltrd(ji,jj,ktrd) + pstrdmld(ji,jj,jk) * wkx(ji,jj,jk) ! salinity 236 END DO 237 END DO 238 END DO 239 #else 188 240 DO jk = 1, jpktrd 189 241 tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,jk) * wkx(:,:,jk) ! temperature 190 242 smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,jk) * wkx(:,:,jk) ! salinity 191 243 END DO 244 #endif 192 245 CASE ( '2D' ) ! forcing at upper boundary of the mixed-layer 193 246 tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,1) * wkx(:,:,1) ! non penetrative … … 198 251 ! 199 252 END SUBROUTINE trd_mld_zint 200 253 254 !! * Reset control of array index permutation 255 !FTRANS CLEAR 256 # include "oce_ftrans.h90" 257 # include "dom_oce_ftrans.h90" 258 # include "trdmld_oce_ftrans.h90" 259 # include "ldftra_oce_ftrans.h90" 260 # include "zdf_oce_ftrans.h90" 261 # include "ldfslp_ftrans.h90" 262 # include "zdfddm_ftrans.h90" 263 201 264 202 265 SUBROUTINE trd_mld( kt ) … … 261 324 LOGICAL :: lldebug = .TRUE. 262 325 REAL(wp) :: zavt, zfn, zfn2 326 327 #if defined key_z_first 328 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 329 #else 263 330 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 331 #endif 332 264 333 #if defined key_dimgout 265 334 INTEGER :: iyear,imon,iday … … 269 338 270 339 ! Check that the workspace arrays are all OK to be used 340 #if defined key_z_first 341 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) ) THEN 342 CALL ctl_stop('trd_mld : requested workspace arrays unavailable') ; RETURN 343 END IF 344 ALLOCATE( ztmltrd2(jpi,jpj,jpltrd) ) 345 ALLOCATE( zsmltrd2(jpi,jpj,jpltrd) ) 346 #else 271 347 IF( wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 272 348 wrk_in_use(3, 1,2) ) THEN … … 280 356 ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 281 357 zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 358 #endif 282 359 283 360 ! ====================================================================== … … 333 410 ! -------------------------------- 334 411 tml(:,:) = 0.e0 ; sml(:,:) = 0.e0 412 #if defined key_z_first 413 DO jj = 1, jpj 414 DO ji = 1, jpi 415 DO jk = 1, jpktrd - 1 416 tml(ji,jj) = tml(ji,jj) + wkx(ji,jj,jk) * tn(ji,jj,jk) 417 sml(ji,jj) = sml(ji,jj) + wkx(ji,jj,jk) * sn(ji,jj,jk) 418 END DO 419 END DO 420 END DO 421 #else 335 422 DO jk = 1, jpktrd - 1 336 423 tml(:,:) = tml(:,:) + wkx(:,:,jk) * tn(:,:,jk) 337 424 sml(:,:) = sml(:,:) + wkx(:,:,jk) * sn(:,:,jk) 338 425 END DO 426 #endif 339 427 340 428 ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window … … 740 828 IF( lrst_oce ) CALL trd_mld_rst_write( kt ) 741 829 830 #if defined key_z_first 831 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) ) & 832 CALL ctl_stop('trd_mld : failed to release workspace arrays.') 833 DEALLOCATE( ztmltrd2, zsmltrd2 ) 834 #else 742 835 IF( wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 743 836 wrk_not_released(3, 1,2) ) & 744 837 CALL ctl_stop('trd_mld : failed to release workspace arrays.') 838 #endif 745 839 ! 746 840 END SUBROUTINE trd_mld
Note: See TracChangeset
for help on using the changeset viewer.
