Changeset 7753 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
- Timestamp:
- 2017-03-03T12:46:59+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
r7698 r7753 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 arrays143 142 REAL(wp) :: zs2rdt 144 143 LOGICAL :: lldebug = .FALSE. … … 148 147 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 149 148 150 CALL wrk_alloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin )151 149 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 152 150 … … 157 155 158 156 IF( l_trdtrc ) THEN 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 157 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 158 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 168 159 ENDIF 169 160 ! ! sum over the global domain 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(:,:,:) ) 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(:,:,:) ) 185 166 186 167 IF( ztrcorb /= 0 ) THEN 187 168 zcoef = 1. + ztrcorb / ztrmasb 188 !$OMP PARALLEL DO schedule(static) private(jk)189 169 DO jk = 1, jpkm1 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 170 ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 171 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 196 172 END DO 197 173 ENDIF … … 199 175 IF( ztrcorn /= 0 ) THEN 200 176 zcoef = 1. + ztrcorn / ztrmasn 201 !$OMP PARALLEL DO schedule(static) private(jk)202 177 DO jk = 1, jpkm1 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 178 ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 179 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 209 180 END DO 210 181 ENDIF … … 213 184 ! 214 185 zs2rdt = 1. / ( 2. * rdt ) 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 186 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 187 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 225 188 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 226 189 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 236 199 237 200 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 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 260 215 ! 261 216 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 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 217 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 218 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 271 219 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 272 220 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling … … 279 227 280 228 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 281 CALL wrk_dealloc( jpi, jpj, jpk, zcptrbmax, zcptrnmax, zcptrbmin, zcptrnmin )282 229 283 230 END SUBROUTINE trc_rad_sms
Note: See TracChangeset
for help on using the changeset viewer.
