Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90 (modified) (3 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90
- Property svn:eol-style deleted
r1715 r2528 4 4 !! Ocean data : read ocean temperature data from monthly atlas data 5 5 !!===================================================================== 6 !! History : OPA ! 1991-03 () Original code 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 10 !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread 11 !!---------------------------------------------------------------------- 6 12 #if defined key_dtatem || defined key_esopa 7 13 !!---------------------------------------------------------------------- … … 10 16 !! dta_tem : read ocean temperature data 11 17 !!---l------------------------------------------------------------------- 12 !! * Modules used13 18 USE oce ! ocean dynamics and tracers 14 19 USE dom_oce ! ocean space and time domain 20 USE fldread ! read input fields 15 21 USE in_out_manager ! I/O manager 16 22 USE phycst ! physical constants 17 #if defined key_orca_lev10 18 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 #endif 23 20 24 IMPLICIT NONE 21 25 PRIVATE 22 26 23 !! * Routine accessibility 24 PUBLIC dta_tem ! called by step.F90 and inidta.F90 25 26 !! * Shared module variables 27 PUBLIC dta_tem ! called by step.F90 and inidta.F90 28 27 29 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 29 t_dta !: temperature data at given time-step 30 31 !! * Module variables 32 INTEGER :: & 33 numtdt, & !: logical unit for data temperature 34 ntem1, ntem2 ! first and second record used 35 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 36 temdta ! temperature data at two consecutive times 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta !: temperature data at given time-step 31 32 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read) 37 33 38 34 !! * Substitutions 39 35 # include "domzgr_substitute.h90" 40 36 !!---------------------------------------------------------------------- 41 !! OPA 9.0 , LOCEAN-IPSL (2005)37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 42 38 !! $Id$ 43 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 44 !!---------------------------------------------------------------------- 45 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!---------------------------------------------------------------------- 46 41 CONTAINS 47 48 !!----------------------------------------------------------------------49 !! Default case NetCDF file50 !!----------------------------------------------------------------------51 42 52 43 SUBROUTINE dta_tem( kt ) … … 66 57 !! 67 58 !! ** Action : define t_dta array at time-step kt 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT( in ) :: kt ! ocean time-step 61 ! 62 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 63 INTEGER :: ik, ierror ! temporary integers 64 #if defined key_tradmp 65 INTEGER :: il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 66 #endif 67 REAL(wp):: zl 68 REAL(wp), DIMENSION(jpk) :: ztemdta ! auxiliary array for interpolation 69 ! 70 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 71 TYPE(FLD_N) :: sn_tem 72 LOGICAL , SAVE :: linit_tem = .FALSE. 68 73 !! 69 !! History : 70 !! ! 91-03 () Original code 71 !! ! 92-07 (M. Imbard) 72 !! ! 99-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 73 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 74 NAMELIST/namdta_tem/ cn_dir, sn_tem 74 75 !!---------------------------------------------------------------------- 75 !! * Modules used 76 USE iom 77 78 !! * Arguments 79 INTEGER, INTENT( in ) :: kt ! ocean time-step 80 81 !! * Local declarations 82 INTEGER :: ji, jj, jl, jk, jkk ! dummy loop indicies 83 INTEGER :: & 84 imois, iman, i15 , ik ! temporary integers 85 # if defined key_tradmp 86 INTEGER :: & 87 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 88 # endif 89 REAL(wp) :: zxy, zl 90 #if defined key_orca_lev10 91 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 92 INTEGER :: ikr, ikw, ikt, jjk 93 REAL(wp) :: zfac 94 #endif 95 REAL(wp), DIMENSION(jpk,2) :: & 96 ztemdta ! auxiliary array for interpolation 97 !!---------------------------------------------------------------------- 98 99 ! 0. Initialization 100 ! ----------------- 101 102 iman = INT( raamo ) 103 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 104 i15 = nday / 16 105 imois = nmonth + i15 - 1 106 IF( imois == 0 ) imois = iman 107 108 ! 1. First call kt=nit000 76 77 ! 1. Initialization 109 78 ! ----------------------- 110 79 111 IF( kt == nit000 ) THEN 112 113 ntem1= 0 ! initializations 114 IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 115 CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 116 117 ENDIF 118 80 IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN 81 82 ! ! set file information 83 cn_dir = './' ! directory in which the model is executed 84 ! ... default values (NB: frequency positive => hours, negative => months) 85 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 86 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 87 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' ) 88 89 REWIND( numnam ) ! read in namlist namdta_tem 90 READ( numnam, namdta_tem ) 91 92 IF(lwp) THEN ! control print 93 WRITE(numout,*) 94 WRITE(numout,*) 'dta_tem : Temperature Climatology ' 95 WRITE(numout,*) '~~~~~~~ ' 96 ENDIF 97 ALLOCATE( sf_tem(1), STAT=ierror ) 98 IF( ierror > 0 ) THEN 99 CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN 100 ENDIF 101 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 102 IF( sn_tem%ln_tint ) ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 103 ! ! fill sf_tem with sn_tem and control print 104 CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 105 linit_tem = .TRUE. 106 ! 107 ENDIF 119 108 120 109 ! 2. Read monthly file 121 110 ! ------------------- 122 123 IF( kt == nit000 .OR. imois /= ntem1 ) THEN 124 125 ! Calendar computation 126 127 ntem1 = imois ! first file record used 128 ntem2 = ntem1 + 1 ! last file record used 129 ntem1 = MOD( ntem1, iman ) 130 IF( ntem1 == 0 ) ntem1 = iman 131 ntem2 = MOD( ntem2, iman ) 132 IF( ntem2 == 0 ) ntem2 = iman 133 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 134 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 135 136 ! Read monthly temperature data Levitus 137 138 #if defined key_orca_lev10 139 if (ln_zps) stop 140 ztem(:,:,:,:) = 0. 141 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 142 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 143 #else 144 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 145 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 111 112 CALL fld_read( kt, 1, sf_tem ) 113 114 IF( lwp .AND. kt == nit000 )THEN 115 WRITE(numout,*) 116 WRITE(numout,*) ' read Levitus temperature ok' 117 WRITE(numout,*) 118 ENDIF 119 120 #if defined key_tradmp 121 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 122 ! 123 ij0 = 101 ; ij1 = 109 124 ii0 = 141 ; ii1 = 155 125 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 126 DO ji = mi0(ii0), mi1(ii1) 127 sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20 128 sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 129 sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40 130 END DO 131 END DO 132 ! 133 IF( nn_cla == 1 ) THEN 134 ! ! New temperature profile at Gibraltar 135 il0 = 138 ; il1 = 138 136 ij0 = 101 ; ij1 = 102 137 ii0 = 139 ; ii1 = 139 138 DO jl = mi0(il0), mi1(il1) 139 DO jj = mj0(ij0), mj1(ij1) 140 DO ji = mi0(ii0), mi1(ii1) 141 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 142 END DO 143 END DO 144 END DO 145 ! ! New temperature profile at Bab el Mandeb 146 il0 = 164 ; il1 = 164 147 ij0 = 87 ; ij1 = 88 148 ii0 = 161 ; ii1 = 163 149 DO jl = mi0(il0), mi1(il1) 150 DO jj = mj0(ij0), mj1(ij1) 151 DO ji = mi0(ii0), mi1(ii1) 152 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 153 END DO 154 END DO 155 END DO 156 ELSE 157 ! ! Reduced temperature at Red Sea 158 ij0 = 87 ; ij1 = 96 159 ii0 = 148 ; ii1 = 160 160 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0 161 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5 162 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0 163 ENDIF 164 ! 165 ENDIF 146 166 #endif 147 167 148 IF(lwp) WRITE(numout,*) 149 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 150 IF(lwp) WRITE(numout,*) 151 152 #if defined key_tradmp 153 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 168 t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 169 170 IF( ln_sco ) THEN 171 DO jj = 1, jpj ! interpolation of temperatures 172 DO ji = 1, jpi 173 DO jk = 1, jpk 174 zl=fsdept_0(ji,jj,jk) 175 IF(zl < gdept_0(1)) ztemdta(jk) = t_dta(ji,jj,1) 176 IF(zl > gdept_0(jpk)) ztemdta(jk) = t_dta(ji,jj,jpkm1) 177 DO jkk = 1, jpkm1 178 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 179 ztemdta(jk) = t_dta(ji,jj,jkk) & 180 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 181 & * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk)) 182 ENDIF 183 END DO 184 END DO 185 DO jk = 1, jpkm1 186 t_dta(ji,jj,jk) = ztemdta(jk) 187 END DO 188 t_dta(ji,jj,jpk) = 0.0 189 END DO 190 END DO 154 191 155 ! ! ======================= 156 ! ! ORCA_R2 configuration 157 ! ! ======================= 158 ij0 = 101 ; ij1 = 109 159 ii0 = 141 ; ii1 = 155 160 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 161 DO ji = mi0(ii0), mi1(ii1) 162 #if defined key_orca_lev10 163 ztem( ji,jj, 13:13 ,:) = ztem (ji,jj, 13:13 ,:) - 0.20 164 ztem (ji,jj, 14:15 ,:) = ztem (ji,jj, 14:15 ,:) - 0.35 165 ztem (ji,jj, 16:25 ,:) = ztem (ji,jj, 16:25 ,:) - 0.40 166 #else 167 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 168 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 169 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 170 #endif 171 END DO 172 END DO 192 IF( lwp .AND. kt == nit000 )THEN 193 WRITE(numout,*) 194 WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 195 WRITE(numout,*) 196 ENDIF 173 197 174 IF( n_cla == 1 ) THEN 175 ! ! New temperature profile at Gibraltar 176 il0 = 138 ; il1 = 138 177 ij0 = 101 ; ij1 = 102 178 ii0 = 139 ; ii1 = 139 179 DO jl = mi0(il0), mi1(il1) 180 DO jj = mj0(ij0), mj1(ij1) 181 DO ji = mi0(ii0), mi1(ii1) 182 #if defined key_orca_lev10 183 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 184 #else 185 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 186 #endif 187 END DO 188 END DO 189 END DO 190 ! ! New temperature profile at Bab el Mandeb 191 il0 = 164 ; il1 = 164 192 ij0 = 87 ; ij1 = 88 193 ii0 = 161 ; ii1 = 163 194 DO jl = mi0(il0), mi1(il1) 195 DO jj = mj0(ij0), mj1(ij1) 196 DO ji = mi0(ii0), mi1(ii1) 197 #if defined key_orca_lev10 198 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 199 #else 200 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 201 #endif 202 END DO 203 END DO 204 END DO 205 ! 206 ELSE 207 ! ! Reduced temperature at Red Sea 208 ij0 = 87 ; ij1 = 96 209 ii0 = 148 ; ii1 = 160 210 #if defined key_orca_lev10 211 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 212 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 213 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 214 #else 215 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 216 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 217 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 218 #endif 219 ENDIF 220 ! 221 ENDIF 222 #endif 223 224 #if defined key_orca_lev10 225 ! interpolate from 31 to 301 level the ztem field result in temdta 226 DO jl = 1, 2 227 DO jjk = 1, 5 228 temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 229 END DO 230 DO jk = 1, jpk-20,10 231 ik = jk+5 232 ikr = INT(jk/10) + 1 233 ikw = (ikr-1) *10 + 1 234 ikt = ikw + 5 235 DO jjk=ikt,ikt+9 236 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 237 temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 238 END DO 239 END DO 240 DO jjk = jpk-5, jpk 241 temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 242 END DO 243 ! fill the overlap areas 244 CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 245 END DO 246 #endif 247 248 IF( ln_sco ) THEN 249 DO jl = 1, 2 250 DO jj = 1, jpj ! interpolation of temperatures 251 DO ji = 1, jpi 252 DO jk = 1, jpk 253 zl=fsdept_0(ji,jj,jk) 254 IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) 255 IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(ji,jj,jpkm1,jl) 256 DO jkk = 1, jpkm1 257 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 258 ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & 259 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 260 & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 261 ENDIF 262 END DO 263 END DO 264 DO jk = 1, jpkm1 265 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 266 END DO 267 temdta(ji,jj,jpk,jl) = 0.0 268 END DO 269 END DO 270 END DO 271 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 274 IF(lwp) WRITE(numout,*) 275 276 ELSE 277 278 ! ! Mask 279 DO jl = 1, 2 280 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 281 temdta(:,:,jpk,jl) = 0. 282 IF( ln_zps ) THEN ! z-coord. with partial steps 283 DO jj = 1, jpj ! interpolation of temperature at the last level 284 DO ji = 1, jpi 285 ik = mbathy(ji,jj) - 1 286 IF( ik > 2 ) THEN 287 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 288 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 289 ENDIF 290 END DO 291 END DO 292 ENDIF 293 END DO 294 295 ENDIF 296 297 IF(lwp) THEN 298 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 299 WRITE(numout,*) 300 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 301 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 302 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 303 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 304 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 305 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 306 ENDIF 307 ENDIF 308 309 310 ! 2. At every time step compute temperature data 311 ! ---------------------------------------------- 312 313 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 314 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 315 316 ! Close the file 317 ! -------------- 318 319 IF( kt == nitend ) CALL iom_close (numtdt) 320 321 END SUBROUTINE dta_tem 198 ELSE 199 ! ! Mask 200 t_dta(:,:,: ) = t_dta(:,:,:) * tmask(:,:,:) 201 t_dta(:,:,jpk) = 0. 202 IF( ln_zps ) THEN ! z-coord. with partial steps 203 DO jj = 1, jpj ! interpolation of temperature at the last level 204 DO ji = 1, jpi 205 ik = mbkt(ji,jj) 206 IF( ik > 1 ) THEN 207 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 208 t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 209 ENDIF 210 END DO 211 END DO 212 ENDIF 213 ! 214 ENDIF 215 216 IF( lwp .AND. kt == nit000 ) THEN 217 WRITE(numout,*) ' temperature Levitus ' 218 WRITE(numout,*) 219 WRITE(numout,*)' level = 1' 220 CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 221 WRITE(numout,*)' level = ', jpk/2 222 CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 223 WRITE(numout,*)' level = ', jpkm1 224 CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 225 ENDIF 226 ! 227 END SUBROUTINE dta_tem 322 228 323 229 #else
Note: See TracChangeset
for help on using the changeset viewer.
