- Timestamp:
- 2019-07-31T18:05:50+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_STOPACK/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r4990 r11384 29 29 USE iom ! I/O manager library 30 30 USE lib_mpp ! MPP library 31 USE stopack 31 32 USE wrk_nemo ! Memory allocation 32 33 … … 38 39 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 39 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_evd ! store avt_evd to calculate EVD trend 41 43 42 44 !! * Substitutions … … 55 57 !! *** FUNCTION trd_tra_alloc *** 56 58 !!--------------------------------------------------------------------- 57 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc )59 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc ) 58 60 ! 59 61 IF( lk_mpp ) CALL mpp_sum ( trd_tra_alloc ) … … 104 106 ztrds(:,:,:) = 0._wp 105 107 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 108 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 106 109 CASE DEFAULT ! other trends: masked trends 107 110 trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) ! mask & store … … 128 131 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 129 132 DO jk = 2, jpk 130 zwt(:,:,jk) = 133 zwt(:,:,jk) = avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 131 134 zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 132 135 END DO … … 138 141 END DO 139 142 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt ) 143 ! 144 ! ! Also calculate EVD trend at this point. 145 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 146 DO jk = 2, jpk 147 zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 148 zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 149 END DO 150 ! 151 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 152 DO jk = 1, jpkm1 153 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 154 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 155 END DO 156 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 140 157 ! 141 158 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) … … 233 250 ! ! 3D output of tracers trends using IOM interface 234 251 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 235 236 ! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 252 IF( ln_tra_trd .AND. ln_sppt_tra ) CALL tra_sppt_collect( ptrdx, ptrdy, ktrd, kt ) 253 254 ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 237 255 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 238 256 … … 285 303 !! ** Purpose : output 3D tracer trends using IOM 286 304 !!---------------------------------------------------------------------- 287 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 288 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 289 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 290 INTEGER , INTENT(in ) :: kt ! time step 291 !! 292 INTEGER :: ji, jj, jk ! dummy loop indices 293 INTEGER :: ikbu, ikbv ! local integers 294 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 295 !!---------------------------------------------------------------------- 296 ! 297 !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 298 ! 299 SELECT CASE( ktrd ) 300 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 301 CALL iom_put( "strd_xad" , ptrdy ) 302 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 303 CALL iom_put( "strd_yad" , ptrdy ) 304 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 305 CALL iom_put( "strd_zad" , ptrdy ) 306 IF( .NOT. lk_vvl ) THEN ! cst volume : adv flux through z=0 surface 307 CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 308 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 309 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 310 CALL iom_put( "ttrd_sad", z2dx ) 311 CALL iom_put( "strd_sad", z2dy ) 312 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 313 ENDIF 314 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 315 CALL iom_put( "strd_ldf" , ptrdy ) 316 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 317 CALL iom_put( "strd_zdf" , ptrdy ) 318 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 319 CALL iom_put( "strd_zdfp", ptrdy ) 320 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 321 CALL iom_put( "strd_dmp" , ptrdy ) 322 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 323 CALL iom_put( "strd_bbl" , ptrdy ) 324 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 325 CALL iom_put( "strd_npc" , ptrdy ) 326 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx ) ! surface forcing + runoff (ln_rnf=T) 327 CALL iom_put( "strd_cdt" , ptrdy ) 328 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 329 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 330 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 331 CALL iom_put( "strd_atf" , ptrdy ) 332 END SELECT 333 ! 305 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 306 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 307 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 308 INTEGER , INTENT(in ) :: kt ! time step 309 !! 310 INTEGER :: ji, jj, jk ! dummy loop indices 311 INTEGER :: ikbu, ikbv ! local integers 312 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 313 !!---------------------------------------------------------------------- 314 ! 315 !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 316 ! 317 ! Trends evaluated every time step that could go to the standard T file and can be output every ts into a 1ts file if 1ts output is selected 318 SELECT CASE( ktrd ) 319 ! This total trend is done every time step 320 CASE( jptra_tot ) ; CALL iom_put( "ttrd_tot" , ptrdx ) ! model total trend 321 CALL iom_put( "strd_tot" , ptrdy ) 322 END SELECT 323 324 ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 325 IF( MOD( kt, 2 ) == 0 ) THEN 326 SELECT CASE( ktrd ) 327 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 328 CALL iom_put( "strd_xad" , ptrdy ) 329 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 330 CALL iom_put( "strd_yad" , ptrdy ) 331 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 332 CALL iom_put( "strd_zad" , ptrdy ) 333 IF( .NOT. lk_vvl ) THEN ! cst volume : adv flux through z=0 surface 334 CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 335 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 336 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 337 CALL iom_put( "ttrd_sad", z2dx ) 338 CALL iom_put( "strd_sad", z2dy ) 339 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 340 ENDIF 341 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad" , ptrdx ) ! total advection 342 CALL iom_put( "strd_totad" , ptrdy ) 343 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 344 CALL iom_put( "strd_ldf" , ptrdy ) 345 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 346 CALL iom_put( "strd_zdf" , ptrdy ) 347 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 348 CALL iom_put( "strd_zdfp", ptrdy ) 349 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd", ptrdx ) ! EVD trend (convection) 350 CALL iom_put( "strd_evd", ptrdy ) 351 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 352 CALL iom_put( "strd_dmp" , ptrdy ) 353 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 354 CALL iom_put( "strd_bbl" , ptrdy ) 355 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 356 CALL iom_put( "strd_npc" , ptrdy ) 357 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 358 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 359 CALL iom_put( "strd_cdt" , ptrdy(:,:,1) ) ! output as 2D surface fields 360 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 361 END SELECT 362 ! the Asselin filter trend is also every other time step but needs to be lagged one time step 363 ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step. 364 ELSE IF( MOD( kt, 2 ) == 1 ) THEN 365 SELECT CASE( ktrd ) 366 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 367 CALL iom_put( "strd_atf" , ptrdy ) 368 END SELECT 369 END IF 370 ! 334 371 END SUBROUTINE trd_tra_iom 335 372
Note: See TracChangeset
for help on using the changeset viewer.
