- Timestamp:
- 2012-02-25T16:50:01+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r3294 r3318 4 4 !! Ocean passive tracers: correction of negative concentrations 5 5 !!====================================================================== 6 !! History : - !01-01 (O. Aumont & E. Kestenare) Original code7 !! 1.0 !04-03 (C. Ethe) free form F906 !! History : OPA ! 2001-01 (O. Aumont & E. Kestenare) Original code 7 !! NEMO 1.0 ! 2004-03 (C. Ethe) free form F90 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_top … … 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 !! trc_rad : correction of negative concentrations14 !!---------------------------------------------------------------------- 15 USE oce_trc 16 USE trc 17 USE trd mod_oce18 USE trdtra 19 USE prtctl_trc 13 !! trc_rad : correction of negative concentrations 14 !!---------------------------------------------------------------------- 15 USE oce_trc ! ocean dynamics and tracers variables 16 USE trc ! ocean passive tracers variables 17 USE trd_oce ! trends: ocean variables 18 USE trdtra ! trends: tracer manager 19 USE prtctl_trc ! Print control for debbuging 20 20 21 21 IMPLICIT NONE 22 22 PRIVATE 23 23 24 PUBLIC trc_rad! routine called by trcstp.F9024 PUBLIC trc_rad ! routine called by trcstp.F90 25 25 26 26 !! * Substitutions … … 31 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- 33 34 33 CONTAINS 35 34 … … 49 48 !! (the total CFC content is not strictly preserved) 50 49 !!---------------------------------------------------------------------- 51 INTEGER, INTENT( in ) :: kt ! ocean time-step index 50 INTEGER, INTENT( in ) :: kt ! ocean time-step index 51 ! 52 52 CHARACTER (len=22) :: charout 53 53 !!---------------------------------------------------------------------- … … 77 77 ! 78 78 END SUBROUTINE trc_rad 79 79 80 80 81 SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) … … 94 95 !! (the total content of concentration is not strictly preserved) 95 96 !!-------------------------------------------------------------------------------- 96 !! Arguments 97 INTEGER, INTENT( in ) :: kt ! ocean time-step index 98 INTEGER , INTENT( in ) :: & 99 jp_sms0, & !: First index of the passive tracer model 100 jp_sms1 !: Last index of the passive tracer model 101 102 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT( inout ) :: & 103 ptrb, ptrn !: before and now traceur concentration 104 105 CHARACTER( len = 1) , INTENT(in), OPTIONAL :: & 106 cpreserv !: flag to preserve content or not 107 108 ! Local declarations 109 INTEGER :: ji, jj, jk, jn ! dummy loop indices 110 REAL(wp) :: ztrcorb, ztrmasb ! temporary scalars 111 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 113 REAL(wp) :: zs2rdt 114 LOGICAL :: lldebug = .FALSE. 115 !!---------------------------------------------------------------------- 116 97 INTEGER , INTENT(in ) :: kt ! ocean time-step index 98 INTEGER , INTENT(in ) :: jp_sms0, jp_sms1 ! first/last index of the passive tracer model 99 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) :: ptrb, ptrn ! before/now traceur concentration 100 CHARACTER( len = 1), OPTIONAL , INTENT(in ) :: cpreserv ! flag to preserve content or not 101 ! 102 INTEGER :: ji, jj, jk, jn ! dummy loop indices 103 REAL(wp) :: ztrcorb, ztrmasb, zs2rdt ! local scalars 104 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! - - 105 LOGICAL :: lldebug = .FALSE. 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! 3D workspace 107 !!---------------------------------------------------------------------- 117 108 118 109 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 119 110 120 111 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 121 112 ! ! =========== 113 122 114 DO jn = jp_sms0, jp_sms1 123 ! ! ===========124 ztrcorb = 0. e0 ; ztrmasb = 0.e0125 ztrcorn = 0. e0 ; ztrmasn = 0.e0126 115 ! 116 ztrcorb = 0._wp ; ztrmasb = 0._wp 117 ztrcorn = 0._wp ; ztrmasn = 0._wp 118 ! 127 119 IF( l_trdtrc ) THEN 128 120 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation … … 132 124 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 133 125 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 134 135 126 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 136 127 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 137 128 ! 138 129 IF( ztrcorb /= 0 ) THEN 139 130 zcoef = 1. + ztrcorb / ztrmasb … … 143 134 END DO 144 135 ENDIF 145 136 ! 146 137 IF( ztrcorn /= 0 ) THEN 147 138 zcoef = 1. + ztrcorn / ztrmasn … … 157 148 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 158 149 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 159 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling160 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling150 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 151 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 161 152 ! 162 153 ENDIF 163 154 ! 164 155 END DO 165 156 ! 166 157 ! 167 158 ELSE ! total CFC content is not strictly preserved 168 159 ! 169 160 DO jn = jp_sms0, jp_sms1 170 171 IF( l_trdtrc ) THEN172 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation173 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation174 ENDIF175 161 ! 162 IF( l_trdtrc ) THEN 163 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 164 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 165 ENDIF 166 ! 176 167 DO jk = 1, jpkm1 177 168 DO jj = 1, jpj … … 182 173 END DO 183 174 END DO 184 185 IF( l_trdtrc ) THEN 186 ! 175 ! 176 IF( l_trdtrc ) THEN 187 177 zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc ) ) 188 178 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 189 179 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 190 CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb ) ! Asselin-like trend handling 191 CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn ) ! standard trend handling 192 ! 193 ENDIF 194 ! 195 ENDDO 196 180 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 181 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 182 ENDIF 183 ! 184 END DO 185 ! 197 186 ENDIF 198 187 ! 199 188 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 200 189 ! 201 190 END SUBROUTINE trc_rad_sms 191 202 192 #else 203 193 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
