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