Changeset 5830 for branches/2015/dev_r5721_CNRS9_NOC3_LDF
- Timestamp:
- 2015-10-25T10:28:48+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r5102 r5830 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 … … 42 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_init ! routine called by nemogcm.F90 45 46 ! !!* Namelist namtra_dmp : T & S newtonian damping * 47 LOGICAL , PUBLIC :: ln_tradmp !: internal damping flag 48 INTEGER , PUBLIC :: nn_zdmp !: = 0/1/2 flag for damping in the mixed layer 49 CHARACTER(LEN=200) , PUBLIC :: cn_resto !: name of netcdf file containing restoration coefficient field 51 50 ! 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 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 57 52 … … 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 ) … … 96 91 !! ** Action : - (ta,sa) tracer trends updated with the damping trend 97 92 !!---------------------------------------------------------------------- 98 !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 ! 103 IF( l_trdtra ) THEN !* Save ta and sa trends 104 CALL wrk_alloc( jpi,jpj,jpk,jpts, ztrdts ) 105 ztrdts(:,:,:,:) = tsa(:,:,:,:) 106 ENDIF 107 ! !== input T-S data at kt ==! 111 108 CALL dta_tsd( kt, zts_dta ) ! read and interpolates T-S data at kt 112 109 ! 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 110 SELECT CASE ( nn_zdmp ) !== type of damping ==! 111 ! 112 CASE( 0 ) !* newtonian damping throughout the water column *! 113 DO jn = 1, jpts 114 DO jk = 1, jpkm1 115 DO jj = 2, jpjm1 116 DO ji = fs_2, fs_jpim1 ! vector opt. 117 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) ) 118 END DO 125 119 END DO 126 120 END DO 127 121 END DO 128 122 ! 129 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==!123 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 130 124 DO jk = 1, jpkm1 131 125 DO jj = 2, jpjm1 132 126 DO ji = fs_2, fs_jpim1 ! vector opt. 133 127 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 128 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 129 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 130 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 131 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 139 132 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 133 END DO 145 134 END DO 146 135 END DO 147 136 ! 148 CASE ( 2 ) !== no damping in the mixed layer ==!137 CASE ( 2 ) !* no damping in the mixed layer *! 149 138 DO jk = 1, jpkm1 150 139 DO jj = 2, jpjm1 151 140 DO ji = fs_2, fs_jpim1 ! vector opt. 152 141 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 142 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 143 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 144 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 145 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 158 146 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 147 END DO 164 148 END DO … … 168 152 ! 169 153 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 ) 154 ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 155 CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 156 CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 157 CALL wrk_dealloc( jpi,jpj,jpk,jpts, ztrdts ) 172 158 ENDIF 173 159 ! ! Control print … … 175 161 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 176 162 ! 177 CALL wrk_dealloc( jpi, jpj, jpk, jpts,zts_dta )178 ! 179 IF( nn_timing == 1 ) CALL timing_stop('tra_dmp')163 CALL wrk_dealloc( jpi,jpj,jpk,jpts, zts_dta ) 164 ! 165 IF( nn_timing == 1 ) CALL timing_stop('tra_dmp') 180 166 ! 181 167 END SUBROUTINE tra_dmp … … 190 176 !! ** Method : read the namtra_dmp namelist and check the parameters 191 177 !!---------------------------------------------------------------------- 178 INTEGER :: ios, imask ! local integers 179 !! 192 180 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 181 !!---------------------------------------------------------------------- 197 182 ! … … 204 189 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 205 190 IF(lwm) WRITE ( numond, namtra_dmp ) 206 207 IF(lwp) THEN !Namelist print191 ! 192 IF(lwp) THEN ! Namelist print 208 193 WRITE(numout,*) 209 194 WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation' 210 WRITE(numout,*) '~~~~~~~ '195 WRITE(numout,*) '~~~~~~~~~~~' 211 196 WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters' 212 197 WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp … … 215 200 WRITE(numout,*) 216 201 ENDIF 217 202 ! 218 203 IF( ln_tradmp) THEN 219 ! 220 !Allocate arrays 204 ! ! Allocate arrays 221 205 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' 206 ! 207 SELECT CASE (nn_zdmp) ! Check values of nn_zdmp 208 CASE ( 0 ) ; IF(lwp) WRITE(numout,*) ' tracer damping as specified by mask' 209 CASE ( 1 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixing layer (kz > 5 cm2/s)' 210 CASE ( 2 ) ; IF(lwp) WRITE(numout,*) ' no tracer damping in the mixed layer' 211 CASE DEFAULT 212 CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp') 228 213 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? 214 ! 215 !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine 216 ! so can damp to something other than intitial conditions files? 217 !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated. 232 218 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' ) 219 IF(lwp) WRITE(numout,*) 220 IF(lwp) WRITE(numout, *) ' read T-S data not initialized, we force ln_tsd_tradmp=T' 234 221 CALL dta_tsd_init( ld_tradmp=ln_tradmp ) ! forces the initialisation of T-S data 235 222 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 223 ! ! Read in mask from file 242 224 CALL iom_open ( cn_resto, imask) 243 CALL iom_get ( imask, jpdom_autoglo, 'resto', resto )225 CALL iom_get ( imask, jpdom_autoglo, 'resto', resto ) 244 226 CALL iom_close( imask ) 245 246 227 ENDIF 228 ! 247 229 END SUBROUTINE tra_dmp_init 248 230
Note: See TracChangeset
for help on using the changeset viewer.