- Timestamp:
- 2012-02-21T17:00:02+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r3294 r3316 2 2 !!====================================================================== 3 3 !! *** MODULE trdtra *** 4 !! Ocean diagnostics: ocean tracers trends 4 !! Ocean diagnostics: ocean tracers trends pre-processing 5 5 !!===================================================================== 6 !! History : 1.0 ! 2004-08 (C. Talandier) Original code 7 !! 2.0 ! 2005-04 (C. Deltel) Add Asselin trend in the ML budget 8 !! 3.3 ! 2010-06 (C. Ethe) merge TRA-TRC 6 !! History : 3.3 ! 2010-06 (C. Ethe) creation for the TRA/TRC merge 7 !! 3.5 ! 2012-02 (G. Madec) update the comments 9 8 !!---------------------------------------------------------------------- 10 9 #if defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 11 10 !!---------------------------------------------------------------------- 12 !! trd_tra : Call the trend to be computed13 !! ----------------------------------------------------------------------14 USE dom_oce ! ocean domain15 USE trdmod_oce ! ocean active mixed layer tracers trends16 USE trdmod 17 USE trdmod _trc ! ocean passive mixed layer tracers trends18 USE in_out_manager ! I/O manager19 USE lib_mpp ! MPP library20 USE wrk_nemo ! Memory allocation21 11 !! trd_tra : pre-process the tracer trends and calll trd_mod(_trc) 12 !! trd_tra_adv : transform a div(U.T) trend into a U.grad(T) trend 13 !!---------------------------------------------------------------------- 14 USE dom_oce ! ocean domain 15 USE trdmod_oce ! ocean active mixed layer tracers trends 16 USE trdmod ! ocean active mixed layer tracers trends 17 USE trdmod_trc ! ocean passive mixed layer tracers trends 18 USE in_out_manager ! I/O manager 19 USE lib_mpp ! MPP library 20 USE wrk_nemo ! Memory allocation 22 21 23 22 IMPLICIT NONE 24 23 PRIVATE 25 24 26 PUBLIC trd_tra ! called by all traXXmodules25 PUBLIC trd_tra ! called by all tra_... modules 27 26 28 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt !:27 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 29 28 30 29 !! * Substitutions … … 32 31 # include "vectopt_loop_substitute.h90" 33 32 !!---------------------------------------------------------------------- 34 !! NEMO/OPA 4.0 , NEMO Consortium (2011)33 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 34 !! $Id$ 36 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 53 52 !! *** ROUTINE trd_tra *** 54 53 !! 55 !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 56 !! integral constraints 54 !! ** Purpose : pre-process tracer trends 57 55 !! 58 !! ** Method/usage : For the mixed-layer trend, the control surface can be either 59 !! a mixed layer depth (time varying) or a fixed surface (jk level or bowl). 60 !! Choose control surface with nn_ctls in namelist NAMTRD : 61 !! nn_ctls = 0 : use mixed layer with density criterion 62 !! nn_ctls = 1 : read index from file 'ctlsurf_idx' 63 !! nn_ctls > 1 : use fixed level surface jk = nn_ctls 64 !!---------------------------------------------------------------------- 65 ! 66 INTEGER , INTENT(in) :: kt ! time step 67 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' 68 INTEGER , INTENT(in) :: ktra ! tracer index 69 INTEGER , INTENT(in) :: ktrd ! tracer trend index 70 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux 71 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pun ! velocity 72 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variablea 56 !! ** Method : - mask the trend 57 !! - advection (ptra present) converte the incoming flux (U.T) 58 !! into trend (U.T => -U.grat(T)=div(U.T)-T.div(U)) through a 59 !! call to trd_tra_adv 60 !! - 'TRA' case : regroup T & S trends 61 !! - send the trends to trd_mod(_trc) for further processing 62 !!---------------------------------------------------------------------- 63 INTEGER , INTENT(in) :: kt ! time step 64 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' 65 INTEGER , INTENT(in) :: ktra ! tracer index 66 INTEGER , INTENT(in) :: ktrd ! tracer trend index 67 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux 68 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pun ! now velocity 69 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 73 70 ! 74 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrds 75 72 !!---------------------------------------------------------------------- 76 73 ! 77 74 CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 78 79 IF( .NOT. ALLOCATED( trdtx ) ) THEN 75 ! 76 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays 80 77 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 81 78 ENDIF 82 79 83 ! Control of optional arguments84 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN85 IF( PRESENT( ptra ) ) THEN 86 SELECT CASE( ktrd ) ! shift depending on the direction87 CASE( jptra_trd_xad ) ;CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )88 CASE( jptra_trd_yad ) ;CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )89 CASE( jptra_trd_zad ) ;CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt )80 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN !== Temperature trend ==! 81 ! 82 IF( PRESENT( ptra ) ) THEN ! advection: transform flux into trend 83 SELECT CASE( ktrd ) 84 CASE( jptra_trd_xad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 85 CASE( jptra_trd_yad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 86 CASE( jptra_trd_zad ) ; CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt ) 90 87 END SELECT 91 ELSE 92 trdt(:,:,:) = ptrd(:,:,:) 93 IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN 94 ztrds(:,:,:) = 0. 95 CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 96 END IF 88 ELSE ! other trends: 89 trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) ! mask & store 90 IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN ! qsr, bbc: on temperature only 91 ztrds(:,:,:) = 0._wp 92 CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) ! send to trd_mod 93 ENDIF 94 ENDIF 95 ! 96 ENDIF 97 98 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN !== Salinity trends ==! 99 ! 100 IF( PRESENT( ptra ) ) THEN ! advection: transform the advective flux into a trend 101 SELECT CASE( ktrd ) ! and send T & S trends to trd_mod 102 CASE( jptra_trd_xad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'X' , ztrds ) 103 CALL trd_mod ( trdtx, ztrds, ktrd, ctype, kt ) 104 CASE( jptra_trd_yad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Y' , ztrds ) 105 ; CALL trd_mod ( trdty, ztrds, ktrd, ctype, kt ) 106 CASE( jptra_trd_zad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Z' , ztrds ) 107 CALL trd_mod ( trdt , ztrds, ktrd, ctype, kt ) 108 END SELECT 109 ELSE ! other trends: mask and send T & S trends to trd_mod 110 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 111 CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 112 ENDIF 113 ! 114 ENDIF 115 116 IF( ctype == 'TRC' ) THEN !== passive tracer trend ==! 117 ! 118 IF( PRESENT( ptra ) ) THEN ! advection: transform flux into a trend 119 SELECT CASE( ktrd ) 120 CASE( jptra_trd_xad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds ) 121 CASE( jptra_trd_yad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 122 CASE( jptra_trd_zad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 123 END SELECT 124 ELSE ! other trends: mask 125 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 97 126 END IF 98 END IF 99 100 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN 101 IF( PRESENT( ptra ) ) THEN 102 SELECT CASE( ktrd ) ! shift depending on the direction 103 CASE( jptra_trd_xad ) 104 CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 105 CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt ) 106 CASE( jptra_trd_yad ) 107 CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 108 CALL trd_mod( trdty, ztrds, ktrd, ctype, kt ) 109 CASE( jptra_trd_zad ) 110 CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 111 CALL trd_mod( trdt , ztrds, ktrd, ctype, kt ) 112 END SELECT 113 ELSE 114 ztrds(:,:,:) = ptrd(:,:,:) 115 CALL trd_mod( trdt, ztrds, ktrd, ctype, kt ) 116 END IF 117 END IF 118 119 IF( ctype == 'TRC' ) THEN 120 ! 121 IF( PRESENT( ptra ) ) THEN 122 SELECT CASE( ktrd ) ! shift depending on the direction 123 CASE( jptra_trd_xad ) 124 CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 125 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 126 CASE( jptra_trd_yad ) 127 CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 128 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 129 CASE( jptra_trd_zad ) 130 CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 131 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 132 END SELECT 133 ELSE 134 ztrds(:,:,:) = ptrd(:,:,:) 135 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) 136 END IF 127 ! 128 CALL trd_mod_trc( ztrds, ktra, ktrd, kt ) ! send trend to trd_mod_trc 137 129 ! 138 130 ENDIF … … 147 139 !! *** ROUTINE trd_tra_adv *** 148 140 !! 149 !! ** Purpose : transformed the i-, j- or k-advective flux into thes 150 !! i-, j- or k-advective trends, resp. 151 !! ** Method : i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] ) 152 !! k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] ) 153 !! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 154 !!---------------------------------------------------------------------- 155 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pf ! advective flux in one direction 156 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! now velocity in one direction 157 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: ptn ! now or before tracer 158 CHARACTER(len=1), INTENT(in ) :: cdir ! X/Y/Z direction 159 REAL(wp) , INTENT(out), DIMENSION(jpi,jpj,jpk) :: ptrd ! advective trend in one direction 141 !! ** Purpose : transformed a advective flux into a masked advective trends 142 !! 143 !! ** Method : use the following transformation: -div(U.T) = - U grad(T) + T.div(U) 144 !! i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] ) 145 !! j-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] ) 146 !! k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] ) 147 !! where fi is the incoming advective flux. 148 !!---------------------------------------------------------------------- 149 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pf ! advective flux in one direction 150 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pun ! now velocity in one direction 151 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: ptn ! now or before tracer 152 CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction 153 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction 160 154 ! 161 155 INTEGER :: ji, jj, jk ! dummy loop indices 162 INTEGER :: ii, ij, ik ! index shift function of the direction 163 REAL(wp) :: zbtr ! local scalar 164 !!---------------------------------------------------------------------- 165 166 SELECT CASE( cdir ) ! shift depending on the direction 167 CASE( 'X' ) ; ii = 1 ; ij = 0 ; ik = 0 ! i-advective trend 168 CASE( 'Y' ) ; ii = 0 ; ij = 1 ; ik = 0 ! j-advective trend 169 CASE( 'Z' ) ; ii = 0 ; ij = 0 ; ik =-1 ! k-advective trend 156 INTEGER :: ii, ij, ik ! index shift as function of the direction 157 !!---------------------------------------------------------------------- 158 ! 159 SELECT CASE( cdir ) ! shift depending on the direction 160 CASE( 'X' ) ; ii = 1 ; ij = 0 ; ik = 0 ! i-trend 161 CASE( 'Y' ) ; ii = 0 ; ij = 1 ; ik = 0 ! j-trend 162 CASE( 'Z' ) ; ii = 0 ; ij = 0 ; ik =-1 ! k-trend 170 163 END SELECT 171 172 ! ! set to zero uncomputed values 173 ptrd(jpi,:,:) = 0.e0 ; ptrd(1,:,:) = 0.e0 174 ptrd(:,jpj,:) = 0.e0 ; ptrd(:,1,:) = 0.e0 175 ptrd(:,:,jpk) = 0.e0 176 ! 177 ! 178 DO jk = 1, jpkm1 164 ! 165 ! ! set to zero uncomputed values 166 ptrd(jpi,:,:) = 0._wp ; ptrd(1,:,:) = 0._wp 167 ptrd(:,jpj,:) = 0._wp ; ptrd(:,1,:) = 0._wp 168 ptrd(:,:,jpk) = 0._wp 169 ! 170 DO jk = 1, jpkm1 ! advective trend 179 171 DO jj = 2, jpjm1 180 172 DO ji = fs_2, fs_jpim1 ! vector opt. 181 zbtr = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )182 ptrd(ji,jj,jk) = - zbtr * ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)&183 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk))173 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 174 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) & 175 & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) 184 176 END DO 185 177 END DO … … 188 180 END SUBROUTINE trd_tra_adv 189 181 190 # 182 #else 191 183 !!---------------------------------------------------------------------- 192 184 !! Default case : Dummy module No trend diagnostics … … 196 188 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra ) 197 189 !!---------------------------------------------------------------------- 198 INTEGER , INTENT(in) :: kt ! time step 199 CHARACTER(len=3) , INTENT(in) :: ctype ! tracers trends type 'TRA'/'TRC' 200 INTEGER , INTENT(in) :: ktra ! tracer index 201 INTEGER , INTENT(in) :: ktrd ! tracer trend index 202 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend 203 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! velocity 204 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! Tracer variable 205 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1), & 206 & ktrd, ktra, ctype, kt 190 CHARACTER(len=3) , INTENT(in) :: ctype 191 INTEGER , INTENT(in) :: kt, ktra, ktrd 192 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd 193 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu, ptra ! Tracer variable 194 WRITE(*,*) 'trd_tra: You should not have seen this print! error ?', & 195 & ptrd(1,1,1), ptra(1,1,1), pu(1,1,1), ktrd, ktra, ctype, kt 207 196 END SUBROUTINE trd_tra 208 # endif 197 #endif 198 209 199 !!====================================================================== 210 200 END MODULE trdtra
Note: See TracChangeset
for help on using the changeset viewer.
