Changeset 2528 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90 (modified) (5 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
- Property svn:executable deleted
r1271 r2528 5 5 !!====================================================================== 6 6 !!====================================================================== 7 !! History : 7.0 ! 91-11 (G. Madec) Original code 8 !! ! 93-03 (M. Guyon) symetrical conditions 9 !! ! 95-02 (M. Levy) passive tracers 10 !! ! 96-02 (G. Madec & M. Imbard) opa release 8.0 11 !! 8.0 ! 96-04 (A. Weaver) Euler forward step 12 !! 8.2 ! 99-02 (G. Madec, N. Grima) semi-implicit pressure grad. 13 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 14 !! ! 02-11 (C. Talandier, A-M Treguier) Open boundaries 15 !! 9.0 ! 04-03 (C. Ethe) passive tracers 16 !! ! 07-02 (C. Deltel) Diagnose ML trends for passive tracers 7 !! History : 7.0 ! 1991-11 (G. Madec) Original code 8 !! ! 1993-03 (M. Guyon) symetrical conditions 9 !! ! 1995-02 (M. Levy) passive tracers 10 !! ! 1996-02 (G. Madec & M. Imbard) opa release 8.0 11 !! 8.0 ! 1996-04 (A. Weaver) Euler forward step 12 !! 8.2 ! 1999-02 (G. Madec, N. Grima) semi-implicit pressure grad. 13 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 14 !! ! 2002-08 (G. Madec) F90: Free form and module 15 !! ! 2002-11 (C. Talandier, A-M Treguier) Open boundaries 16 !! ! 2004-03 (C. Ethe) passive tracers 17 !! ! 2007-02 (C. Deltel) Diagnose ML trends for passive tracers 18 !! 2.0 ! 2006-02 (L. Debreu, C. Mazauric) Agrif implementation 19 !! 3.0 ! 2008-06 (G. Madec) time stepping always done in trazdf 20 !! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option 21 !! 3.3 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC 17 22 !!---------------------------------------------------------------------- 18 23 #if defined key_top … … 24 29 !! * Modules used 25 30 USE oce_trc ! ocean dynamics and tracers variables 26 USE tr p_trc ! ocean passive tracers variables31 USE trc ! ocean passive tracers variables 27 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 USE trctrp_lec ! pasive tracers transport29 33 USE prtctl_trc ! Print control for debbuging 30 USE trdmld_trc 31 USE trdmld_trc_oce 34 USE trdmod_oce 35 USE trdtra 36 USE tranxt 37 # if defined key_agrif 32 38 USE agrif_top_update 33 39 USE agrif_top_interp 40 # endif 34 41 35 42 IMPLICIT NONE … … 38 45 !! * Routine accessibility 39 46 PUBLIC trc_nxt ! routine called by step.F90 47 48 REAL(wp), DIMENSION(jpk) :: r2dt 40 49 !!---------------------------------------------------------------------- 41 !! TOP 1.0 , LOCEAN-IPSL (2005)50 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 42 51 !! $Id$ 43 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 53 !!---------------------------------------------------------------------- 45 54 … … 70 79 !! ** Action : - update trb, trn 71 80 !!---------------------------------------------------------------------- 72 USE oce, ONLY : ztrtrd => ua ! use ua as 3D workspace73 81 !! * Arguments 74 82 INTEGER, INTENT( in ) :: kt ! ocean time-step index 75 83 !! * Local declarations 76 INTEGER :: j i, jj, jk, jn ! dummy loop indices84 INTEGER :: jk, jn ! dummy loop indices 77 85 REAL(wp) :: zfact ! temporary scalar 78 86 CHARACTER (len=22) :: charout 87 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdt 79 88 !!---------------------------------------------------------------------- 80 89 81 IF( kt == nit trc000 .AND. lwp ) THEN90 IF( kt == nit000 .AND. lwp ) THEN 82 91 WRITE(numout,*) 83 92 WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 84 93 ENDIF 85 94 95 ! Update after tracer on domain lateral boundaries 86 96 DO jn = 1, jptra 97 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 98 END DO 87 99 88 ! 0. Lateral boundary conditions on tra (T-point, unchanged sign)89 ! ---------------------------------============90 CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )91 92 ! ! ===============93 DO jk = 1, jpk ! Horizontal slab94 ! ! ===============95 ! 1. Leap-frog scheme (only in explicit case, otherwise the96 ! ------------------- time stepping is already done in trczdf)97 IF( l_trczdf_exp .AND. ( ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN98 zfact = 2. * rdttra(jk) * FLOAT(ndttrc)99 IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc)100 tra(:,:,jk,jn) = ( trb(:,:,jk,jn) + zfact * tra(:,:,jk,jn) ) * tmask(:,:,jk)101 ENDIF102 103 END DO104 100 105 101 #if defined key_obc 106 CALL ctl_stop( ' Passive tracers and Open Boundary condition can not be used together ' & 107 & ' Check in trc_nxt routine' ) 102 !! CALL obc_trc( kt ) ! OBC open boundaries 103 #endif 104 #if defined key_bdy 105 !! CALL bdy_trc( kt ) ! BDY open boundaries 106 #endif 107 #if defined key_agrif 108 CALL Agrif_trc ! AGRIF zoom boundaries 108 109 #endif 109 110 111 112 ! set time step size (Euler/Leapfrog) 113 IF( neuler == 0 .AND. kt == nit000) THEN ; r2dt(:) = rdttrc(:) ! at nit000 (Euler) 114 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog) 115 ENDIF 116 117 ! trends computation initialisation 118 IF( l_trdtrc ) THEN 119 ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) ) !* store now fields before applying the Asselin filter 120 ztrdt(:,:,:,:) = trn(:,:,:,:) 121 ENDIF 122 ! Leap-Frog + Asselin filter time stepping 123 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 124 ! ! (only swap) 125 DO jn = 1, jptra 126 DO jk = 1, jpkm1 127 trn(:,:,jk,jn) = tra(:,:,jk,jn) 128 END DO 129 END DO 130 ! 131 ELSE 132 ! Leap-Frog + Asselin filter time stepping 133 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl) 134 ELSE ; CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 135 ENDIF 136 ENDIF 137 110 138 #if defined key_agrif 111 ! ! =============== 112 END DO ! End of slab 113 ! ! =============== 114 ! Interp tracers on boundaries (coarse => fine) 115 CALL Agrif_trc 116 ! ! =============== 117 DO jn = 1, jptra ! Horizontal slab 118 ! ! =============== 119 #endif 139 ! Update tracer at AGRIF zoom boundaries 140 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Trc( kt ) ! children only 141 #endif 120 142 121 DO jk = 1, jpk 122 123 ! 2. Time filter and swap of arrays 124 ! --------------------------------- 125 IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN 126 127 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 131 trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 132 tra(ji,jj,jk,jn) = 0. 133 END DO 134 END DO 135 IF( l_trdtrc ) ztrtrd(:,:,:) = 0.e0 ! no trend 136 ELSE 137 IF( l_trdtrc ) THEN ! Asselin trend 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 ztrtrd(ji,jj,jk) = atfp * ( trb(ji,jj,jk,jn) - 2*trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) 141 END DO 142 END DO 143 ENDIF 144 145 DO jj = 1, jpj 146 DO ji = 1, jpi 147 trb(ji,jj,jk,jn) = atfp * ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) + atfp1 * trn(ji,jj,jk,jn) 148 trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 149 tra(ji,jj,jk,jn) = 0. 150 END DO 151 END DO 152 ENDIF 153 ELSE ! >> EULER-FORWARD schemes (SMOLAR, MUSCL) 154 IF( l_trdtrc ) ztrtrd(:,:,:) = 0.e0 ! no trend 155 156 DO jj = 1, jpj 157 DO ji = 1, jpi 158 trb(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 159 trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 160 tra(ji,jj,jk,jn) = 0. 161 END DO 162 END DO 163 164 ENDIF 165 ! ! =============== 166 END DO ! End of slab 167 ! ! =============== 168 169 IF( l_trdtrc ) THEN ! trends 170 DO jk = 1, jpk 171 zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 172 ztrtrd(:,:,jk) = ztrtrd(:,:,jk) / zfact ! n.b. ztrtrd=0 in Euler-forward case 143 ! trends computation 144 IF( l_trdtrc ) THEN ! trends 145 DO jn = 1, jptra 146 DO jk = 1, jpkm1 147 zfact = 1.e0 / r2dt(jk) 148 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 149 CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt ) 173 150 END DO 174 IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_atf, kt ) 175 ENDIF 176 ! ! =========== 177 END DO ! tracer loop 178 ! ! =========== 179 151 END DO 152 DEALLOCATE( ztrdt ) 153 END IF 154 ! 180 155 IF(ln_ctl) THEN ! print mean trends (used for debugging) 181 156 WRITE(charout, FMT="('nxt')") … … 183 158 CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 184 159 ENDIF 185 186 #if defined key_agrif 187 IF (.NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) 188 #endif 189 190 160 ! 191 161 END SUBROUTINE trc_nxt 192 162
Note: See TracChangeset
for help on using the changeset viewer.
