Changeset 459 for trunk/NEMO/OPA_SRC/DTA/dtatem.F90
- Timestamp:
- 2006-05-10T19:09:01+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DTA/dtatem.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DTA/dtatem.F90
r440 r459 83 83 INTEGER, PARAMETER :: & 84 84 jpmois = 12 ! number of month 85 INTEGER :: ji, jj, jl ! dummy loop indicies 85 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 86 REAL(wp), DIMENSION(jpk,2) :: & 87 ztemdta ! auxiliary array for interpolation 88 86 89 INTEGER :: & 87 90 imois, iman, itime, ik , & ! temporary integers … … 98 101 !!---------------------------------------------------------------------- 99 102 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 103 ! 0. Initialization 104 ! ----------------- 105 106 iman = jpmois 107 i15 = nday / 16 108 imois = nmonth + i15 - 1 109 IF( imois == 0 ) imois = iman 110 111 itime = jpmois 112 ipi = jpiglo 113 ipj = jpjglo 114 ipk = jpk 115 116 ! 1. First call kt=nit000 117 ! ----------------------- 118 119 IF( kt == nit000 .AND. nlecte == 0 ) THEN 120 ntem1 = 0 121 IF(lwp) WRITE(numout,*) 122 IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 123 IF(lwp) WRITE(numout,*) ' ~~~~~~' 124 IF(lwp) WRITE(numout,*) ' NetCDF FORMAT' 125 IF(lwp) WRITE(numout,*) 126 127 ! open file 128 129 cl_tdata = 'data_1m_potential_temperature_nomask ' 127 130 #if defined key_agrif 128 129 130 131 #endif 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 131 if ( .NOT. Agrif_Root() ) then 132 cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 133 endif 134 #endif 135 CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1), nlcj & 136 & , .false. , ipi , ipj , ipk , zlon & 137 & , zlat , zlev , itime, istep , zdate0 & 138 & , rdt , numtdt ) 139 140 ! title, dimensions and tests 141 142 IF( itime /= jpmois ) THEN 143 IF(lwp) THEN 144 WRITE(numout,*) 145 WRITE(numout,*) 'problem with time coordinates' 146 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 147 ENDIF 148 STOP 'dtatem' 149 ENDIF 150 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 151 IF(lwp) THEN 152 WRITE(numout,*) 153 WRITE(numout,*) 'problem with dimensions' 154 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 155 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 156 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 157 ENDIF 158 STOP 'dtatem' 159 ENDIF 160 IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 161 162 ENDIF 163 164 165 ! 2. Read monthly file 166 ! ------------------- 167 168 IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 169 nlecte = 1 170 171 ! Calendar computation 172 173 ntem1 = imois ! first file record used 174 ntem2 = ntem1 + 1 ! last file record used 175 ntem1 = MOD( ntem1, iman ) 176 IF( ntem1 == 0 ) ntem1 = iman 177 ntem2 = MOD( ntem2, iman ) 178 IF( ntem2 == 0 ) ntem2 = iman 179 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 180 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 181 182 ! Read monthly temperature data Levitus 183 184 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 185 , jpmois, ntem1 , ntem1 , mig(1), nlci & 186 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,1) ) 187 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 188 , jpmois, ntem2 , ntem2 , mig(1), nlci & 189 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,2) ) 190 191 IF(lwp) WRITE(numout,*) 192 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 193 IF(lwp) WRITE(numout,*) 194 192 195 #if defined key_tradmp 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 196 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 197 198 ! ! ======================= 199 ! ! ORCA_R2 configuration 200 ! ! ======================= 201 202 ij0 = 101 ; ij1 = 109 203 ii0 = 141 ; ii1 = 155 204 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 205 DO ji = mi0(ii0), mi1(ii1) 206 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 207 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 208 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 209 END DO 210 END DO 211 212 IF( n_cla == 0 ) THEN 213 ! ! Reduced temperature at Red Sea 214 ij0 = 87 ; ij1 = 96 215 ii0 = 148 ; ii1 = 160 216 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 217 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 218 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 219 ELSE 220 il0 = 138 ; il1 = 138 221 ij0 = 101 ; ij1 = 102 222 ii0 = 139 ; ii1 = 139 223 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Gibraltar 224 DO jj = mj0(ij0), mj1(ij1) 225 DO ji = mi0(ii0), mi1(ii1) 226 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 227 END DO 228 END DO 229 END DO 230 il0 = 164 ; il1 = 164 231 ij0 = 88 ; ij1 = 88 232 ii0 = 161 ; ii1 = 163 233 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Bab el Mandeb 234 DO jj = mj0(ij0), mj1(ij1) 235 DO ji = mi0(ii0), mi1(ii1) 236 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 237 END DO 238 END DO 239 ij0 = 87 ; ij1 = 87 240 DO jj = mj0(ij0), mj1(ij1) 241 DO ji = mi0(ii0), mi1(ii1) 242 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 243 END DO 244 END DO 245 END DO 246 ENDIF 247 248 ENDIF 246 249 #endif 247 250 248 ! ! Mask 249 DO jl = 1, 2 250 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 251 temdta(:,:,jpk,jl) = 0. 252 IF( lk_zps ) THEN ! z-coord. with partial steps 253 DO jj = 1, jpj ! interpolation of temperature at the last level 254 DO ji = 1, jpi 255 ik = mbathy(ji,jj) - 1 256 IF( ik > 2 ) THEN 257 zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 258 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 259 ENDIF 260 END DO 261 END DO 262 ENDIF 263 END DO 264 265 IF(lwp) THEN 266 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 267 WRITE(numout,*) 268 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 269 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 270 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 271 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 272 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 273 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 274 ENDIF 275 ENDIF 276 277 278 ! 2. At every time step compute temperature data 279 ! ---------------------------------------------- 280 281 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 282 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 283 251 IF( ln_sco ) THEN 252 DO jl = 1, 2 253 DO jj = 1, jpj ! interpolation of temperatures 254 DO ji = 1, jpi 255 DO jk = 1, jpk 256 zl=fsdept(ji,jj,jk) 257 IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) 258 IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(ji,jj,jpkm1,jl) 259 DO jkk = 1, jpkm1 260 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 261 ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & 262 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 263 & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 264 ENDIF 265 END DO 266 END DO 267 DO jk = 1, jpkm1 268 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 269 END DO 270 temdta(ji,jj,jpk,jl) = 0.0 271 END DO 272 END DO 273 END DO 274 275 IF(lwp) WRITE(numout,*) 276 IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 277 IF(lwp) WRITE(numout,*) 278 279 ELSE 280 281 ! ! Mask 282 DO jl = 1, 2 283 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 284 temdta(:,:,jpk,jl) = 0. 285 IF( ln_zps ) THEN ! z-coord. with partial steps 286 DO jj = 1, jpj ! interpolation of temperature at the last level 287 DO ji = 1, jpi 288 ik = mbathy(ji,jj) - 1 289 IF( ik > 2 ) THEN 290 zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 291 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 292 ENDIF 293 END DO 294 END DO 295 ENDIF 296 END DO 297 298 ENDIF 299 300 IF(lwp) THEN 301 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 302 WRITE(numout,*) 303 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 304 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 305 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 306 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 307 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 308 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 309 ENDIF 310 ENDIF 311 312 313 ! 2. At every time step compute temperature data 314 ! ---------------------------------------------- 315 316 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 317 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 284 318 285 319 END SUBROUTINE dta_tem
Note: See TracChangeset
for help on using the changeset viewer.
