Changeset 503 for trunk/NEMO/OPA_SRC/TRA/tranxt.F90
- Timestamp:
- 2006-09-27T10:52:29+02:00 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/tranxt.F90
r457 r503 4 4 !! Ocean active tracers: time stepping on temperature and salinity 5 5 !!====================================================================== 6 !! History : 7 !! 7.0 ! 91-11 (G. Madec) Original code 8 !! ! 93-03 (M. Guyon) symetrical conditions 9 !! ! 96-02 (G. Madec & M. Imbard) opa release 8.0 10 !! 8.0 ! 96-04 (A. Weaver) Euler forward step 11 !! 8.2 ! 99-02 (G. Madec, N. Grima) semi-implicit pressure grad. 12 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 13 !! ! 02-11 (C. Talandier, A-M Treguier) Open boundaries 14 !! 9.0 ! 06-02 (L. Debreu, C. Mazauric) Agrif implementation 6 !! History : 7.0 ! 91-11 (G. Madec) Original code 7 !! ! 93-03 (M. Guyon) symetrical conditions 8 !! ! 96-02 (G. Madec & M. Imbard) opa release 8.0 9 !! 8.0 ! 96-04 (A. Weaver) Euler forward step 10 !! 8.2 ! 99-02 (G. Madec, N. Grima) semi-implicit pressure grad. 11 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 12 !! ! 02-11 (C. Talandier, A-M Treguier) Open boundaries 13 !! ! 05-04 (C. Deltel) Add Asselin trend in the ML budget 14 !! 9.0 ! 06-02 (L. Debreu, C. Mazauric) Agrif implementation 15 !!---------------------------------------------------------------------- 16 15 17 !!---------------------------------------------------------------------- 16 18 !! tra_nxt : time stepping on temperature and salinity 17 19 !!---------------------------------------------------------------------- 18 !! * Modules used19 20 USE oce ! ocean dynamics and tracers variables 20 21 USE dom_oce ! ocean space and time domain variables … … 23 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 25 USE obctra ! open boundary condition (obc_tra routine) 26 USE trdmod ! ocean active tracers trends 27 USE trdmod_oce ! ocean variables trends 25 28 USE prtctl ! Print control 26 29 USE agrif_opa_update … … 31 34 32 35 !! * Routine accessibility 33 PUBLIC tra_nxt! routine called by step.F9034 !!---------------------------------------------------------------------- 35 !! OPA 9.0 , LOCEAN-IPSL (200 5)36 PUBLIC tra_nxt ! routine called by step.F90 37 !!---------------------------------------------------------------------- 38 !! OPA 9.0 , LOCEAN-IPSL (2006) 36 39 !! $Header$ 37 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 38 41 !!---------------------------------------------------------------------- 39 42 … … 67 70 !! ** Action : - update (tb,sb) and (tn,sn) 68 71 !! - (ta,sa) time averaged (t,s) (ln_dynhpg_imp = T) 69 !!70 72 !!---------------------------------------------------------------------- 71 !! * Arguments 72 INTEGER, INTENT( in ) :: kt ! ocean time-step index 73 74 !! * Local declarations 75 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp) :: zt, zs ! temporary scalars 77 REAL(wp) :: zfact ! temporary scalar 73 USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace 74 USE oce, ONLY : ztrds => va ! use va as 3D workspace 75 !! 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 !! 78 INTEGER :: ji, jj, jk ! dummy loop indices 79 REAL(wp) :: zt, zs ! temporary scalars 80 REAL(wp) :: zfact ! temporary scalar 78 81 !!---------------------------------------------------------------------- 79 82 80 83 IF( l_trdtra ) THEN 84 ztrdt(:,:,jpk) = 0.e0 85 ztrds(:,:,jpk) = 0.e0 86 ENDIF 81 87 ! 0. Lateral boundary conditions on ( ta, sa ) (T-point, unchanged sign) 82 88 ! ---------------------------------============ … … 84 90 CALL lbc_lnk( sa, 'T', 1. ) 85 91 86 87 92 ! ! =============== 88 93 DO jk = 1, jpkm1 ! Horizontal slab … … 93 98 IF( ln_zdfexp ) THEN 94 99 zfact = 2. * rdttra(jk) 95 IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk)100 IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk) 96 101 ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk) 97 102 sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk) 103 IF(l_trdtra) CALL ctl_stop( 'tranxt: Asselin ML trend not yet accounted for.' ) 98 104 ENDIF 99 105 … … 102 108 END DO ! End of slab 103 109 ! ! =============== 104 105 110 ! Update tracers on open boundaries. 106 111 CALL obc_tra( kt ) 107 108 112 ! ! =============== 109 113 DO jk = 1, jpkm1 ! Horizontal slab … … 114 118 END DO ! End of slab 115 119 ! ! =============== 116 117 120 ! Update tracers on open boundaries. 118 121 CALL Agrif_tra( kt ) 119 120 122 ! ! =============== 121 123 DO jk = 1, jpkm1 ! Horizontal slab 122 124 ! ! =============== 123 125 #endif 124 125 126 126 ! 2. Time filter and swap of arrays 127 127 ! --------------------------------- … … 141 141 END DO 142 142 END DO 143 IF( l_trdtra ) THEN 144 ztrdt(:,:,jk) = 0.e0 145 ztrds(:,:,jk) = 0.e0 146 END IF 143 147 ELSE 144 148 DO jj = 1, jpj … … 148 152 tb(ji,jj,jk) = atfp * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) 149 153 sb(ji,jj,jk) = atfp * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) 154 IF( l_trdtra ) THEN ! ChD ceci est a optimiser, mais ca marche 155 ztrdt(ji,jj,jk) = tb(ji,jj,jk) - tn(ji,jj,jk) 156 ztrds(ji,jj,jk) = sb(ji,jj,jk) - sn(ji,jj,jk) 157 END IF 150 158 tn(ji,jj,jk) = ta(ji,jj,jk) 151 159 sn(ji,jj,jk) = sa(ji,jj,jk) … … 165 173 END DO 166 174 END DO 175 IF( l_trdtra ) THEN 176 ztrdt(:,:,jk) = 0.e0 177 ztrds(:,:,jk) = 0.e0 178 END IF 167 179 ELSE 180 IF( l_trdtra ) THEN 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 ztrdt(ji,jj,jk) = atfp * ( tb(ji,jj,jk) - 2*tn(ji,jj,jk) + ta(ji,jj,jk) ) 184 ztrds(ji,jj,jk) = atfp * ( sb(ji,jj,jk) - 2*sn(ji,jj,jk) + sa(ji,jj,jk) ) 185 END DO 186 END DO 187 END IF 168 188 DO jj = 1, jpj 169 189 DO ji = 1, jpi … … 180 200 ! ! =============== 181 201 182 IF(ln_ctl) THEN ! print mean field (used for debugging) 183 CALL prt_ctl(tab3d_1=tn, clinfo1=' nxt - Tn: ', mask1=tmask, & 184 & tab3d_2=sn, clinfo2=' Sn: ', mask2=tmask) 185 ENDIF 186 202 IF( l_trdtra ) THEN ! Take the Asselin trend into account 203 ztrdt(:,:,:) = ztrdt(:,:,:) / ( 2.*rdt ) 204 ztrds(:,:,:) = ztrds(:,:,:) / ( 2.*rdt ) 205 CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt ) 206 END IF 207 208 IF(ln_ctl) CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt - Tn: ', mask1=tmask, & 209 & tab3d_2=sn, clinfo2= ' Sn: ', mask2=tmask ) 187 210 #if defined key_agrif 188 211 IF (.NOT.Agrif_Root()) CALL Agrif_Update_Tra( kt ) 189 212 #endif 190 213 ! 191 214 END SUBROUTINE tra_nxt 192 215
Note: See TracChangeset
for help on using the changeset viewer.