- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r5102 r6808 6 6 !! History : OPA ! 1991-03 (O. Marti, G. Madec) Original code 7 7 !! ! 1992-06 (M. Imbard) doctor norme 8 !! ! 1996-01 (G. Madec) statement function for e39 !! ! 1997-05 (G. Madec) macro-tasked on jk-slab10 8 !! ! 1998-07 (M. Imbard, G. Madec) ORCA version 11 !! 7.0 ! 2001-02 (M. Imbard) cofdis, Original code9 !! 7.0 ! 2001-02 (M. Imbard) add distance to coast, Original code 12 10 !! 8.1 ! 2001-02 (G. Madec, E. Durand) cleaning 13 11 !! NEMO 1.0 ! 2002-08 (G. Madec, E. Durand) free form + modules … … 15 13 !! 3.3 ! 2010-06 (C. Ethe, G. Madec) merge TRA-TRC 16 14 !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 15 !! 3.6 ! 2015-06 (T. Graham) read restoring coefficient in a file 16 !! 3.7 ! 2015-10 (G. Madec) remove useless trends arrays 17 17 !!---------------------------------------------------------------------- 18 18 … … 31 31 USE dtatsd ! data: temperature & salinity 32 32 USE zdfmxl ! vertical physics: mixed layer depth 33 ! 33 34 USE in_out_manager ! I/O manager 34 35 USE lib_mpp ! MPP library … … 41 42 PRIVATE 42 43 43 PUBLIC tra_dmp ! routine called by step.F90 44 PUBLIC tra_dmp_init ! routine called by opa.F90 45 46 ! !!* Namelist namtra_dmp : T & S newtonian damping * 47 ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90 48 LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag 49 INTEGER , PUBLIC :: nn_zdmp ! = 0/1/2 flag for damping in the mixed layer 50 CHARACTER(LEN=200) , PUBLIC :: cn_resto ! name of netcdf file containing restoration coefficient field 44 PUBLIC tra_dmp ! called by step.F90 45 PUBLIC tra_dmp_init ! called by nemogcm.F90 46 47 ! !!* Namelist namtra_dmp : T & S newtonian damping * 48 LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag 49 INTEGER , PUBLIC :: nn_zdmp !: = 0/1/2 flag for damping in the mixed layer 50 CHARACTER(LEN=200) , PUBLIC :: cn_resto !: name of netcdf file containing restoration coefficient field 51 51 ! 52 53 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: strdmp !: damping salinity trend (psu/s)55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ttrdmp !: damping temperature trend (Celcius/s)56 52 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 57 53 58 54 !! * Substitutions 59 # include "domzgr_substitute.h90"60 55 # include "vectopt_loop_substitute.h90" 61 56 !!---------------------------------------------------------------------- … … 70 65 !! *** FUNCTION tra_dmp_alloc *** 71 66 !!---------------------------------------------------------------------- 72 ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk),resto(jpi,jpj,jpk), STAT= tra_dmp_alloc )67 ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 73 68 ! 74 69 IF( lk_mpp ) CALL mpp_sum ( tra_dmp_alloc ) … … 94 89 !! below the well mixed layer (nlmdmp=2) 95 90 !! 96 !! ** Action : - (ta,sa) tracer trends updated with the damping trend 97 !!---------------------------------------------------------------------- 98 ! 91 !! ** Action : - tsa: tracer trends updated with the damping trend 92 !!---------------------------------------------------------------------- 99 93 INTEGER, INTENT(in) :: kt ! ocean time-step index 100 !! 101 INTEGER :: ji, jj, jk ! dummy loop indices 102 REAL(wp) :: zta, zsa ! local scalars 103 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta 104 !!---------------------------------------------------------------------- 105 ! 106 IF( nn_timing == 1 ) CALL timing_start( 'tra_dmp') 107 ! 108 CALL wrk_alloc( jpi, jpj, jpk, jpts, zts_dta ) 109 ! 110 ! !== input T-S data at kt ==! 94 ! 95 INTEGER :: ji, jj, jk, jn ! dummy loop indices 96 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zts_dta, ztrdts 97 !!---------------------------------------------------------------------- 98 ! 99 IF( nn_timing == 1 ) CALL timing_start('tra_dmp') 100 ! 101 CALL wrk_alloc( jpi,jpj,jpk,jpts, zts_dta ) 102 IF( l_trdtra ) THEN !* Save ta and sa trends 103 CALL wrk_alloc( jpi,jpj,jpk,jpts, ztrdts ) 104 ztrdts(:,:,:,:) = tsa(:,:,:,:) 105 ENDIF 106 ! !== input T-S data at kt ==! 111 107 CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt 112 108 ! 113 SELECT CASE ( nn_zdmp ) !== type of damping ==! 114 ! 115 CASE( 0 ) !== newtonian damping throughout the water column ==! 116 DO jk = 1, jpkm1 117 DO jj = 2, jpjm1 118 DO ji = fs_2, fs_jpim1 ! vector opt. 119 zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 120 zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 121 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 122 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 123 strdmp(ji,jj,jk) = zsa ! save the trend (used in asmtrj) 124 ttrdmp(ji,jj,jk) = zta 109 SELECT CASE ( nn_zdmp ) !== type of damping ==! 110 ! 111 CASE( 0 ) !* newtonian damping throughout the water column *! 112 DO jn = 1, jpts 113 DO jk = 1, jpkm1 114 DO jj = 2, jpjm1 115 DO ji = fs_2, fs_jpim1 ! vector opt. 116 tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) ) 117 END DO 125 118 END DO 126 119 END DO 127 120 END DO 128 121 ! 129 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==!122 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 130 123 DO jk = 1, jpkm1 131 124 DO jj = 2, jpjm1 132 125 DO ji = fs_2, fs_jpim1 ! vector opt. 133 126 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 134 zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 135 zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 136 ELSE 137 zta = 0._wp 138 zsa = 0._wp 127 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 128 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 129 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 139 131 ENDIF 140 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta141 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa142 strdmp(ji,jj,jk) = zsa ! save the salinity trend (used in asmtrj)143 ttrdmp(ji,jj,jk) = zta144 132 END DO 145 133 END DO 146 134 END DO 147 135 ! 148 CASE ( 2 ) !== no damping in the mixed layer ==!136 CASE ( 2 ) !* no damping in the mixed layer *! 149 137 DO jk = 1, jpkm1 150 138 DO jj = 2, jpjm1 151 139 DO ji = fs_2, fs_jpim1 ! vector opt. 152 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 153 zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 154 zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 155 ELSE 156 zta = 0._wp 157 zsa = 0._wp 140 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 141 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 143 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 158 145 ENDIF 159 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta160 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa161 strdmp(ji,jj,jk) = zsa ! save the salinity trend (used in asmtrj)162 ttrdmp(ji,jj,jk) = zta163 146 END DO 164 147 END DO … … 168 151 ! 169 152 IF( l_trdtra ) THEN ! trend diagnostic 170 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp ) 171 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp ) 153 ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 154 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 155 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 156 CALL wrk_dealloc( jpi,jpj,jpk,jpts, ztrdts ) 172 157 ENDIF 173 158 ! ! Control print … … 175 160 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 176 161 ! 177 CALL wrk_dealloc( jpi, jpj, jpk, jpts,zts_dta )178 ! 179 IF( nn_timing == 1 ) CALL timing_stop('tra_dmp')162 CALL wrk_dealloc( jpi,jpj,jpk,jpts, zts_dta ) 163 ! 164 IF( nn_timing == 1 ) CALL timing_stop('tra_dmp') 180 165 ! 181 166 END SUBROUTINE tra_dmp … … 190 175 !! ** Method : read the namtra_dmp namelist and check the parameters 191 176 !!---------------------------------------------------------------------- 177 INTEGER :: ios, imask ! local integers 178 ! 192 179 NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto 193 INTEGER :: ios ! Local integer for output status of namelist read194 INTEGER :: imask ! File handle195 !!196 180 !!---------------------------------------------------------------------- 197 181 ! … … 204 188 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 205 189 IF(lwm) WRITE ( numond, namtra_dmp ) 206 207 IF(lwp) THEN !Namelist print190 ! 191 IF(lwp) THEN ! Namelist print 208 192 WRITE(numout,*) 209 193 WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation' 210 WRITE(numout,*) '~~~~~~~ '194 WRITE(numout,*) '~~~~~~~~~~~' 211 195 WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters' 212 196 WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp … … 215 199 WRITE(numout,*) 216 200 ENDIF 217 201 ! 218 202 IF( ln_tradmp) THEN 219 ! 220 !Allocate arrays 203 ! ! Allocate arrays 221 204 IF( tra_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 222 223 !Check values of nn_zdmp 224 SELECT CASE (nn_zdmp) 225 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask' 226 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the turbocline' 227 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 205 ! 206 SELECT CASE (nn_zdmp) ! Check values of nn_zdmp 207 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask' 208 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixing layer (kz > 5 cm2/s)' 209 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 210 CASE DEFAULT 211 CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp') 228 212 END SELECT 229 230 !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine 231 !so can damp to something other than intitial conditions files? 213 ! 214 !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine 215 ! so can damp to something other than intitial conditions files? 216 !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated. 232 217 IF( .NOT.ln_tsd_tradmp ) THEN 233 CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 218 IF(lwp) WRITE(numout,*) 219 IF(lwp) WRITE(numout, *) ' read T-S data not initialized, we force ln_tsd_tradmp=T' 234 220 CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data 235 221 ENDIF 236 237 !initialise arrays - Are these actually used anywhere else? 238 strdmp(:,:,:) = 0._wp 239 ttrdmp(:,:,:) = 0._wp 240 241 !Read in mask from file 222 ! ! Read in mask from file 242 223 CALL iom_open ( cn_resto, imask) 243 CALL iom_get ( imask, jpdom_autoglo, 'resto', resto )224 CALL iom_get ( imask, jpdom_autoglo, 'resto', resto ) 244 225 CALL iom_close( imask ) 245 246 226 ENDIF 227 ! 247 228 END SUBROUTINE tra_dmp_init 248 229 230 !!====================================================================== 249 231 END MODULE tradmp
Note: See TracChangeset
for help on using the changeset viewer.
