Changeset 7698 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r7646 r7698 29 29 !!---------------------------------------------------------------------- 30 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 !! $Id$ 31 !! $Id$ 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- … … 140 140 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 141 141 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 142 REAL(wp), POINTER, DIMENSION(:,:,:) :: zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ! workspace arrays 142 143 REAL(wp) :: zs2rdt 143 144 LOGICAL :: lldebug = .FALSE. … … 147 148 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 148 149 150 CALL wrk_alloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ) 149 151 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 150 152 … … 155 157 156 158 IF( l_trdtrc ) THEN 157 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 158 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 160 DO jk = 1, jpk 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ztrtrdb(ji,jj,jk) = ptrb(ji,jj,jk,jn) ! save input trb for trend computation 164 ztrtrdn(ji,jj,jk) = ptrn(ji,jj,jk,jn) 165 END DO 166 END DO 167 END DO 159 168 ENDIF 160 169 ! ! sum over the global domain 161 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 162 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 163 164 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 165 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 170 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 171 DO jk = 1, jpk 172 DO jj = 1, jpj 173 DO ji = 1, jpi 174 zcptrbmin(ji,jj,jk) = MIN( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 175 zcptrnmin(ji,jj,jk) = MIN( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 176 zcptrbmax(ji,jj,jk) = MAX( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 177 zcptrnmax(ji,jj,jk) = MAX( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 178 END DO 179 END DO 180 END DO 181 ztrcorb = glob_sum( zcptrbmin(:,:,:) ) 182 ztrcorn = glob_sum( zcptrnmin(:,:,:) ) 183 ztrmasb = glob_sum( zcptrbmax(:,:,:) ) 184 ztrmasn = glob_sum( zcptrnmax(:,:,:) ) 166 185 167 186 IF( ztrcorb /= 0 ) THEN 168 187 zcoef = 1. + ztrcorb / ztrmasb 188 !$OMP PARALLEL DO schedule(static) private(jk) 169 189 DO jk = 1, jpkm1 170 ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 171 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 193 ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 194 END DO 195 END DO 172 196 END DO 173 197 ENDIF … … 175 199 IF( ztrcorn /= 0 ) THEN 176 200 zcoef = 1. + ztrcorn / ztrmasn 201 !$OMP PARALLEL DO schedule(static) private(jk) 177 202 DO jk = 1, jpkm1 178 ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 179 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 203 DO jj = 1, jpj 204 DO ji = 1, jpi 205 ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 206 ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef * tmask(ji,jj,jk) 207 END DO 208 END DO 180 209 END DO 181 210 ENDIF … … 184 213 ! 185 214 zs2rdt = 1. / ( 2. * rdt ) 186 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 187 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 215 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 216 DO jk = 1, jpk 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 ztrtrdb(ji,jj,jk) = ( ptrb(ji,jj,jk,jn) - ztrtrdb(ji,jj,jk) ) * zs2rdt 220 ztrtrdn(ji,jj,jk) = ( ptrn(ji,jj,jk,jn) - ztrtrdn(ji,jj,jk) ) * zs2rdt 221 END DO 222 END DO 223 END DO 224 188 225 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 189 226 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 199 236 200 237 IF( l_trdtrc ) THEN 201 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 202 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 203 ENDIF 204 205 DO jk = 1, jpkm1 206 DO jj = 1, jpj 207 DO ji = 1, jpi 208 ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 209 ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 210 END DO 211 END DO 212 END DO 213 214 IF( l_trdtrc ) THEN 238 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 239 DO jk = 1, jpk 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 ztrtrdb(ji,jj,jk) = ptrb(ji,jj,jk,jn) ! save input trb for trend computation 243 ztrtrdn(ji,jj,jk) = ptrn(ji,jj,jk,jn) 244 END DO 245 END DO 246 END DO 247 END IF 248 249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 250 DO jk = 1, jpkm1 251 DO jj = 1, jpj 252 DO ji = 1, jpi 253 ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 254 ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 255 END DO 256 END DO 257 END DO 258 259 IF( l_trdtrc ) THEN 215 260 ! 216 261 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 217 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 218 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 262 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 263 DO jk = 1, jpk 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 ztrtrdb(ji,jj,jk) = ( ptrb(ji,jj,jk,jn) - ztrtrdb(ji,jj,jk) ) * zs2rdt 267 ztrtrdn(ji,jj,jk) = ( ptrn(ji,jj,jk,jn) - ztrtrdn(ji,jj,jk) ) * zs2rdt 268 END DO 269 END DO 270 END DO 219 271 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 220 272 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 227 279 228 280 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 281 CALL wrk_dealloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin ) 229 282 230 283 END SUBROUTINE trc_rad_sms
Note: See TracChangeset
for help on using the changeset viewer.
