Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r2715 r3294 52 52 CHARACTER (len=22) :: charout 53 53 !!---------------------------------------------------------------------- 54 55 IF( kt == nit000 ) THEN 54 ! 55 IF( nn_timing == 1 ) CALL timing_start('trc_rad') 56 ! 57 IF( kt == nittrc000 ) THEN 56 58 IF(lwp) WRITE(numout,*) 57 59 IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' … … 65 67 IF( lk_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1 ) ! MY_TRC model 66 68 67 68 69 ! 69 70 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 72 73 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 73 74 ENDIF 75 ! 76 IF( nn_timing == 1 ) CALL timing_stop('trc_rad') 74 77 ! 75 78 END SUBROUTINE trc_rad … … 104 107 105 108 ! Local declarations 106 INTEGER :: 107 REAL(wp) :: z volk, ztrcorb, ztrmasb ! temporary scalars109 INTEGER :: ji, jj, jk, jn ! dummy loop indices 110 REAL(wp) :: ztrcorb, ztrmasb ! temporary scalars 108 111 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 109 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrdb ! workspace arrays 110 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrdn ! workspace arrays 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 111 113 REAL(wp) :: zs2rdt 112 114 LOGICAL :: lldebug = .FALSE. 113 114 !!---------------------------------------------------------------------- 115 116 IF( l_trdtrc ) THEN 117 ! 118 ALLOCATE( ztrtrdb(jpi,jpj,jpk) ) 119 ALLOCATE( ztrtrdn(jpi,jpj,jpk) ) 120 ! 121 ENDIF 115 !!---------------------------------------------------------------------- 116 117 118 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 122 119 123 120 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 124 121 125 122 DO jn = jp_sms0, jp_sms1 126 ! ! ===========123 ! ! =========== 127 124 ztrcorb = 0.e0 ; ztrmasb = 0.e0 128 125 ztrcorn = 0.e0 ; ztrmasn = 0.e0 129 126 130 IF( l_trdtrc ) THEN 131 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 132 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 133 ENDIF 134 135 136 DO jk = 1, jpkm1 137 DO jj = 1, jpj 138 DO ji = 1, jpi 139 zvolk = cvol(ji,jj,jk) 140 # if defined key_degrad 141 zvolk = zvolk * facvol(ji,jj,jk) 142 # endif 143 ztrcorb = ztrcorb + MIN( 0., ptrb(ji,jj,jk,jn) ) * zvolk 144 ztrcorn = ztrcorn + MIN( 0., ptrn(ji,jj,jk,jn) ) * zvolk 145 146 ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 147 ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 148 149 ztrmasb = ztrmasb + ptrb(ji,jj,jk,jn) * zvolk 150 ztrmasn = ztrmasn + ptrn(ji,jj,jk,jn) * zvolk 151 END DO 152 END DO 153 END DO 154 155 IF( lk_mpp ) THEN 156 CALL mpp_sum( ztrcorb ) ! sum over the global domain 157 CALL mpp_sum( ztrcorn ) ! sum over the global domain 158 CALL mpp_sum( ztrmasb ) ! sum over the global domain 159 CALL mpp_sum( ztrmasn ) ! sum over the global domain 160 ENDIF 127 IF( l_trdtrc ) THEN 128 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 129 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 130 ENDIF 131 ! ! sum over the global domain 132 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 133 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 134 135 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 136 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 161 137 162 138 IF( ztrcorb /= 0 ) THEN 163 139 zcoef = 1. + ztrcorb / ztrmasb 164 140 DO jk = 1, jpkm1 141 ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 165 142 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 166 143 END DO … … 170 147 zcoef = 1. + ztrcorn / ztrmasn 171 148 DO jk = 1, jpkm1 149 ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 172 150 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 173 151 END DO … … 207 185 IF( l_trdtrc ) THEN 208 186 ! 209 zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc) )187 zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc ) ) 210 188 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 211 189 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt … … 219 197 ENDIF 220 198 221 IF( l_trdtrc ) DEALLOCATE(ztrtrdb, ztrtrdn )199 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 222 200 223 201 END SUBROUTINE trc_rad_sms
Note: See TracChangeset
for help on using the changeset viewer.