Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/dtatsd.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DOM/dtatsd.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DOM/dtatsd.F90
r13497 r14789 6 6 !! History : OPA ! 1991-03 () Original code 7 7 !! - ! 1992-07 (M. Imbard) 8 !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 10 !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread 11 11 !! 3.4 ! 2010-11 (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys … … 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain 20 USE domtile 20 21 USE fldread ! read input fields 21 22 ! … … 39 40 !!---------------------------------------------------------------------- 40 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 41 !! $Id$ 42 !! $Id$ 42 43 !! Software governed by the CeCILL license (see ./LICENSE) 43 44 !!---------------------------------------------------------------------- … … 47 48 !!---------------------------------------------------------------------- 48 49 !! *** ROUTINE dta_tsd_init *** 49 !! 50 !! ** Purpose : initialisation of T & S input data 51 !! 50 !! 51 !! ** Purpose : initialisation of T & S input data 52 !! 52 53 !! ** Method : - Read namtsd namelist 53 !! - allocates T & S data structure 54 !! - allocates T & S data structure 54 55 !!---------------------------------------------------------------------- 55 56 LOGICAL, INTENT(in), OPTIONAL :: ld_tradmp ! force the initialization when tradp is used … … 74 75 75 76 IF( PRESENT( ld_tradmp ) ) ln_tsd_dmp = .TRUE. ! forces the initialization when tradmp is used 76 77 77 78 IF(lwp) THEN ! control print 78 79 WRITE(numout,*) … … 123 124 !!---------------------------------------------------------------------- 124 125 !! *** ROUTINE dta_tsd *** 125 !! 126 !! 126 127 !! ** Purpose : provides T and S data at kt 127 !! 128 !! 128 129 !! ** Method : - call fldread routine 129 !! - ORCA_R2: add some hand made alteration to read data 130 !! - ORCA_R2: add some hand made alteration to read data 130 131 !! - 'key_orca_lev10' interpolates on 10 times more levels 131 132 !! - s- or mixed z-s coordinate: vertical interpolation on model mesh … … 135 136 !! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt 136 137 !!---------------------------------------------------------------------- 137 INTEGER 138 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data138 INTEGER , INTENT(in ) :: kt ! ocean time-step 139 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 139 140 ! 140 141 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 141 142 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 143 INTEGER :: itile 144 INTEGER, DIMENSION(jpts), SAVE :: irec_b, irec_n 142 145 REAL(wp):: zl, zi ! local scalars 143 146 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 144 147 !!---------------------------------------------------------------------- 145 148 ! 146 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 149 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 150 itile = ntile 151 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 152 CALL fld_read( kt, 1, sf_tsd ) !== read T & S data at kt time step ==! 147 153 ! 148 154 ! 149 155 !!gm This should be removed from the code ===>>>> T & S files has to be changed 150 ! 151 ! !== ORCA_R2 configuration and T & S damping ==! 152 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 153 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 154 ! 155 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 156 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 157 DO jj = mj0(ij0), mj1(ij1) 158 DO ji = mi0(ii0), mi1(ii1) 159 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 160 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 161 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 162 ! 163 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 164 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 165 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 166 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 167 END DO 168 END DO 169 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 170 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 171 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 172 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 173 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 174 ENDIF 175 ENDIF 156 ! 157 ! !== ORCA_R2 configuration and T & S damping ==! 158 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 159 IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN ! some hand made alterations 160 irec_n(jp_tem) = sf_tsd(jp_tem)%nrec(2,sf_tsd(jp_tem)%naa) ! Determine if there is new data (ln_tint = F) 161 irec_n(jp_sal) = sf_tsd(jp_sal)%nrec(2,sf_tsd(jp_sal)%naa) ! If not, then do not apply the increments 162 IF( kt == nit000 ) irec_b(:) = -1 163 ! 164 ij0 = 101 + nn_hls ; ij1 = 109 + nn_hls ! Reduced T & S in the Alboran Sea 165 ii0 = 141 + nn_hls - 1 ; ii1 = 155 + nn_hls - 1 166 IF( sf_tsd(jp_tem)%ln_tint .OR. irec_n(jp_tem) /= irec_b(jp_tem) ) THEN 167 DO jj = mj0(ij0), mj1(ij1) 168 DO ji = mi0(ii0), mi1(ii1) 169 sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp 170 sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp 171 sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp 172 END DO 173 END DO 174 irec_b(jp_tem) = irec_n(jp_tem) 175 ENDIF 176 ! 177 IF( sf_tsd(jp_sal)%ln_tint .OR. irec_n(jp_sal) /= irec_b(jp_sal) ) THEN 178 DO jj = mj0(ij0), mj1(ij1) 179 DO ji = mi0(ii0), mi1(ii1) 180 sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp 181 sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp 182 sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp 183 sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp 184 END DO 185 END DO 186 irec_b(jp_sal) = irec_n(jp_sal) 187 ENDIF 188 ! 189 ij0 = 87 + nn_hls ; ij1 = 96 + nn_hls ! Reduced temperature in Red Sea 190 ii0 = 148 + nn_hls - 1 ; ii1 = 160 + nn_hls - 1 191 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0_wp 192 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 193 sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp 194 ENDIF 195 ENDIF 176 196 !!gm end 177 ! 178 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 179 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 197 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 198 ENDIF 199 ! 200 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 201 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk) ! NO mask 202 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 203 END_3D 180 204 ! 181 205 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 182 206 ! 183 IF( kt == nit000 .AND. lwp )THEN 184 WRITE(numout,*) 185 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 186 ENDIF 187 ! 188 DO_2D( 1, 1, 1, 1 ) ! vertical interpolation of T & S 207 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 208 IF( kt == nit000 .AND. lwp )THEN 209 WRITE(numout,*) 210 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 211 ENDIF 212 ENDIF 213 ! 214 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! vertical interpolation of T & S 189 215 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 216 zl = gdept_0(ji,jj,jk) … … 199 225 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 200 226 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 201 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 227 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 202 228 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 203 229 ENDIF … … 212 238 ptsd(ji,jj,jpk,jp_sal) = 0._wp 213 239 END_2D 214 ! 240 ! 215 241 ELSE !== z- or zps- coordinate ==! 216 ! 217 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 218 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 242 ! 243 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 244 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 245 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 246 END_3D 219 247 ! 220 248 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 221 DO_2D( 1, 1, 1, 1)222 ik = mbkt(ji,jj) 249 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 250 ik = mbkt(ji,jj) 223 251 IF( ik > 1 ) THEN 224 252 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) … … 228 256 ik = mikt(ji,jj) 229 257 IF( ik > 1 ) THEN 230 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 258 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 231 259 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 232 260 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) … … 237 265 ENDIF 238 266 ! 239 IF( .NOT.ln_tsd_dmp ) THEN !== deallocate T & S structure ==! 267 IF( .NOT.ln_tsd_dmp ) THEN !== deallocate T & S structure ==! 240 268 ! (data used only for initialisation) 241 269 IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
Note: See TracChangeset
for help on using the changeset viewer.
