Changeset 473 for trunk/NEMO/OPA_SRC/DTA
- Timestamp:
- 2006-05-11T17:04:37+02:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DTA
- Files:
-
- 4 edited
-
dtasal.F90 (modified) (3 diffs)
-
dtasss.F90 (modified) (2 diffs)
-
dtasst.F90 (modified) (7 diffs)
-
dtatem.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DTA/dtasal.F90
r459 r473 14 14 USE dom_oce ! ocean space and time domain 15 15 USE in_out_manager ! I/O manager 16 USE phycst ! physical constants 16 17 USE daymod ! calendar 18 #if defined key_orca_lev10 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 #endif 17 21 18 22 IMPLICIT NONE … … 29 33 !! * Module variables 30 34 INTEGER :: & 31 nlecsa = 0, & ! switch for the first read 32 nsal1 , & ! first record used 33 nsal2 ! second record used 35 numsdt, & !: logical unit for data salinity 36 nsal1, nsal2 ! first and second record used 34 37 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 35 38 saldta ! salinity data at two consecutive times … … 50 53 51 54 SUBROUTINE dta_sal( kt ) 52 !!---------------------------------------------------------------------- 53 !! *** ROUTINE dta_sal *** 54 !! 55 !! ** Purpose : Reads monthly salinity data 56 !! 57 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 58 !! lated onto the model grid. 59 !! - At each time step, a linear interpolation is applied 60 !! between two monthly values. 61 !! 62 !! History : 63 !! ! 91-03 () Original code 64 !! ! 92-07 (M. Imbard) 65 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 66 !!---------------------------------------------------------------------- 67 !! * Modules used 68 USE ioipsl 69 70 !! * Arguments 71 INTEGER, INTENT(in) :: kt ! ocean time step 72 73 !! * Local declarations 74 CHARACTER (len=32) :: clname 75 76 INTEGER, PARAMETER :: jpmois = 12, jpf = 1 77 INTEGER :: ji, jj, jl, jkk ! dummy loop indicies 78 REAL(wp), DIMENSION(jpk,2) :: & 79 zsaldta ! auxiliary array for interpolation 80 81 INTEGER :: & 82 imois, iman, ik, i15, & ! temporary integers 83 ipi, ipj, ipk, itime ! " " 84 #if defined key_tradmp 85 INTEGER :: & 86 jk, il0, il1, & ! temporary integers 87 ii0, ii1, ij0, ij1 ! " " 88 #endif 89 INTEGER, DIMENSION(jpmois) :: istep 90 REAL(wp) :: & 91 zxy, zl, zdate0 92 REAL(wp), DIMENSION(jpi,jpj) :: zlon, zlat 93 REAL(wp), DIMENSION(jpk) :: zlev 94 !!---------------------------------------------------------------------- 95 55 !!---------------------------------------------------------------------- 56 !! *** ROUTINE dta_sal *** 57 !! 58 !! ** Purpose : Reads monthly salinity data 59 !! 60 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 61 !! lated onto the model grid. 62 !! - At each time step, a linear interpolation is applied 63 !! between two monthly values. 64 !! 65 !! History : 66 !! ! 91-03 () Original code 67 !! ! 92-07 (M. Imbard) 68 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 69 !!---------------------------------------------------------------------- 70 !! * Modules used 71 USE iom 72 73 !! * Arguments 74 INTEGER, INTENT(in) :: kt ! ocean time step 75 76 !! * Local declarations 77 78 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 79 INTEGER :: & 80 imois, iman, i15, ik ! temporary integers 81 # if defined key_tradmp 82 INTEGER :: & 83 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 84 # endif 85 REAL(wp) :: zxy, zl 86 #if defined key_orca_lev10 87 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal 88 INTEGER :: ikr, ikw, ikt, jjk 89 REAL(wp) :: zfac 90 #endif 91 REAL(wp), DIMENSION(jpk,2) :: & 92 zsaldta ! auxiliary array for interpolation 93 !!---------------------------------------------------------------------- 94 96 95 ! 0. Initialization 97 96 ! ----------------- 98 99 iman = jpmois 97 98 iman = INT( raamo ) 99 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 100 100 i15 = nday / 16 101 102 101 imois = nmonth + i15 - 1 103 102 IF( imois == 0 ) imois = iman 104 105 itime = jpmois 106 ipi=jpiglo 107 ipj=jpjglo 108 ipk = jpk 109 103 110 104 ! 1. First call kt=nit000 111 105 ! ----------------------- 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' 125 #if defined key_agrif 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 106 107 IF( kt == nit000 ) THEN 108 109 nsal1 = 0 ! initializations 110 IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 111 CALL iom_open ( 'data_1m_salinity_nomask', numsdt ) 112 155 113 ENDIF 156 157 114 115 158 116 ! 2. Read monthly file 159 117 ! ------------------- 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 118 119 IF( kt == nit000 .OR. imois /= nsal1 ) THEN 120 121 ! 2.1 Calendar computation 122 123 nsal1 = imois ! first file record used 124 nsal2 = nsal1 + 1 ! last file record used 125 nsal1 = MOD( nsal1, iman ) 126 IF( nsal1 == 0 ) nsal1 = iman 127 nsal2 = MOD( nsal2, iman ) 128 IF( nsal2 == 0 ) nsal2 = iman 129 IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 130 IF(lwp) WRITE(numout,*) 'last record file used nsal2 ', nsal2 131 132 ! 2.3 Read monthly salinity data Levitus 133 134 #if defined key_orca_lev10 135 if (lk_zps) stop 136 zsal(:,:,:,:) = 0. 137 CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1) 138 CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2) 139 #else 140 CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,1),nsal1) 141 CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,2),nsal2) 142 #endif 143 144 IF(lwp) THEN 145 WRITE(numout,*) 146 WRITE(numout,*) ' read Levitus salinity ok' 147 WRITE(numout,*) 148 ENDIF 149 190 150 #if defined key_tradmp 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 151 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 152 153 ! ! ======================= 154 ! ! ORCA_R2 configuration 155 ! ! ======================= 156 ij0 = 101 ; ij1 = 109 157 ii0 = 141 ; ii1 = 155 158 DO jj = mj0(ij0), mj1(ij1) ! Reduced salinity in the Alboran Sea 159 DO ji = mi0(ii0), mi1(ii1) 160 #if defined key_orca_lev10 161 zsal (ji,jj,13:13,:) = zsal (ji,jj,13:13,:) - 0.15 162 zsal (ji,jj,14:15,:) = zsal (ji,jj,14:15,:) - 0.25 163 zsal (ji,jj,16:17,:) = zsal (ji,jj,16:17,:) - 0.30 164 zsal (ji,jj,18:25,:) = zsal (ji,jj,18:25,:) - 0.35 165 #else 166 saldta(ji,jj,13:13,:) = saldta(ji,jj,13:13,:) - 0.15 167 saldta(ji,jj,14:15,:) = saldta(ji,jj,14:15,:) - 0.25 168 saldta(ji,jj,16:17,:) = saldta(ji,jj,16:17,:) - 0.30 169 saldta(ji,jj,18:25,:) = saldta(ji,jj,18:25,:) - 0.35 170 #endif 171 END DO 172 END DO 173 IF( n_cla == 1 ) THEN 174 ! ! New salinity profile at Gibraltar 175 il0 = 138 ; il1 = 138 176 ij0 = 101 ; ij1 = 101 177 ii0 = 139 ; ii1 = 139 178 #if defined key_orca_lev10 179 zsal ( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) = & 180 & zsal ( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 181 #else 182 saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) = & 183 & saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 184 #endif 185 ij0 = 101 ; ij1 = 101 186 #if defined key_orca_lev10 187 zsal ( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) = & 188 & zsal ( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 189 #else 190 saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) = & 191 & saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 192 #endif 193 il0 = 138 ; il1 = 138 194 ij0 = 101 ; ij1 = 102 195 ii0 = 139 ; ii1 = 139 196 DO jl = mi0(il0), mi1(il1) ! New salinity profile at Gibraltar 197 DO jj = mj0(ij0), mj1(ij1) 198 DO ji = mi0(ii0), mi1(ii1) 199 #if defined key_orca_lev10 200 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 201 #else 202 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 203 #endif 204 END DO 205 END DO 206 END DO 207 208 il0 = 164 ; il1 = 164 209 ij0 = 88 ; ij1 = 88 210 ii0 = 161 ; ii1 = 163 211 DO jl = mi0(il0), mi1(il1) ! New salinity profile at Bab el Mandeb 212 DO jj = mj0(ij0), mj1(ij1) 213 DO ji = mi0(ii0), mi1(ii1) 214 #if defined key_orca_lev10 215 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 216 #else 217 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 218 #endif 219 END DO 220 END DO 221 ij0 = 87 ; ij1 = 87 222 DO jj = mj0(ij0), mj1(ij1) 223 DO ji = mi0(ii0), mi1(ii1) 224 #if defined key_orca_lev10 225 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 226 #else 227 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 228 #endif 229 END DO 230 END DO 231 END DO 232 233 ENDIF 234 235 ENDIF 255 236 #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 237 238 #if defined key_orca_lev10 239 ! interpolate from 31 to 301 level the zsal field result in saldta 240 DO jl = 1, 2 241 DO jjk = 1, 5 242 saldta(:,:,jjk,jl) = zsal(:,:,1,jl) 243 ENDDO 244 DO jk = 1, jpk - 20, 10 245 ikr = INT( jk / 10 ) + 1 246 ikw = (ikr-1) * 10 + 1 247 ikt = ikw + 5 248 DO jjk = ikt , ikt + 9 249 zfac = ( gdept(jjk) - gdepw(ikt) ) / ( gdepw(ikt+10) - gdepw(ikt) ) 250 saldta(:,:,jjk,jl) = zsal(:,:,ikr,jl) + ( zsal(:,:,ikr+1,jl) - zsal(:,:,ikr,jl) ) * zfac 251 END DO 252 END DO 253 DO jjk = jpk-5, jpk 254 saldta(:,:,jjk,jl) = zsal(:,:,jpkdta-1,jl) 255 END DO 256 ! fill the overlap areas 257 CALL lbc_lnk (saldta(:,:,:,jl),'Z',-999.,'no0') 258 END DO 259 260 #endif 261 262 IF( ln_sco ) THEN 263 DO jl = 1, 2 264 DO jj = 1, jpj ! interpolation of salinites 265 DO ji = 1, jpi 266 DO jk = 1, jpk 267 zl=fsdept(ji,jj,jk) 268 IF(zl < gdept_0(1)) zsaldta(jk,jl) = saldta(ji,jj,1,jl) 269 IF(zl > gdept_0(jpk)) zsaldta(jk,jl) = saldta(ji,jj,jpkm1,jl) 270 DO jkk = 1, jpkm1 271 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 272 zsaldta(jk,jl) = saldta(ji,jj,jkk,jl) & 273 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 274 & *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 275 ENDIF 276 END DO 277 END DO 278 DO jk = 1, jpkm1 279 saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 280 END DO 281 saldta(ji,jj,jpk,jl) = 0.0 282 END DO 283 END DO 284 END DO 285 286 IF(lwp) WRITE(numout,*) 287 IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 288 IF(lwp) WRITE(numout,*) 289 290 ELSE 291 ! ! Mask 292 DO jl = 1, 2 293 saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 294 saldta(:,:,jpk,jl) = 0. 295 IF( ln_zps ) THEN ! z-coord. partial steps 296 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 297 DO ji = 1, jpi 298 ik = mbathy(ji,jj) - 1 299 IF( ik > 2 ) THEN 300 zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 301 saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 302 ENDIF 303 END DO 304 END DO 305 ENDIF 306 END DO 307 ENDIF 308 309 310 IF(lwp) THEN 311 WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 312 WRITE(numout,*) 313 WRITE(numout,*) ' Levitus month = ',nsal1,' level = 1' 314 CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 315 WRITE(numout,*) ' Levitus month = ',nsal1,' level = ',jpk/2 316 CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 317 WRITE(numout,*) ' Levitus month = ',nsal1,' level = ',jpkm1 318 CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 319 ENDIF 302 320 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 321 322 318 323 ! 3. At every time step compute salinity data 319 324 ! ------------------------------------------- 320 325 321 326 zxy = FLOAT(nday + 15 - 30*i15)/30. 322 327 s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 328 329 ! Close the file 330 ! -------------- 331 332 IF( kt == nitend ) CALL iom_close (numsdt) 323 333 324 334 END SUBROUTINE dta_sal -
trunk/NEMO/OPA_SRC/DTA/dtasss.F90
r434 r473 27 27 LOGICAL , PUBLIC, PARAMETER :: lk_dtasss = .FALSE. !: sss data flag 28 28 #endif 29 INTEGER :: numsss !: logical unit for surface salinity data 29 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 30 31 sss !: surface salinity … … 63 64 !!---------------------------------------------------------------------- 64 65 !! * Modules used 65 USE io ipsl66 USE iom 66 67 67 68 !! * Arguments 68 69 INTEGER :: kt 69 70 70 !! * Local declarations71 INTEGER :: idy72 INTEGER :: istep(1)73 INTEGER :: ipi, ipj, ipk74 75 REAL(wp) :: zdate0, zdt76 REAL(wp) :: zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk)77 CHARACTER (len=45) :: &78 clname = "sss.nc" ! filename for SSS79 71 !!---------------------------------------------------------------------- 80 72 81 73 IF( kt == nit000 ) THEN 74 82 75 IF(lwp) WRITE(numout,*) 83 IF(lwp) WRITE(numout,*) 'dta_sss : sea surface salinity data' 84 IF(lwp) WRITE(numout,*) '~~~~~~~ read in file: ', clname 85 sss(:,:) = 0.e0 ! required for extra halos in mpp 76 IF(lwp) WRITE(numout,*) 'dta_sss : yearly mean sea surface salinity data' 86 77 87 ipi = jpiglo88 ipj = jpjglo89 ipk = 078 CALL iom_open ( 'sss.nc', numsss ) 79 CALL iom_get ( numsss, jpdom_data, 'sss', sss, 1 ) 80 CALL iom_close ( numsss ) 90 81 91 zdate0 = 0.e092 zdt = 0.e093 IF(lwp) WRITE (numout,*) 'open sss file = ', clname94 95 CALL flinopen( TRIM(clname), mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj, &96 & ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsss )97 98 99 IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN100 IF(lwp) WRITE(numout,*)101 IF(lwp) WRITE(numout,*) 'problem with dimensions'102 IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta103 IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta104 nstop = nstop + 1105 ENDIF106 IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt107 108 CALL flinget( numsss, 'sss', jpidta, jpjdta, 1, idy, 1, &109 & 1, mig(1), nlci, mjg(1), nlcj, sss(1:nlci,1:nlcj) )110 111 82 sss(:,:) = sss(:,:)*tmask(:,:,1) 112 83 113 IF( kt == nit000 .AND.lwp ) THEN84 IF( lwp ) THEN 114 85 WRITE(numout,*) ' ' 115 86 WRITE(numout,*) ' read sea surface salinity ok' 116 87 WRITE(numout,*) ' ' 117 CALL prihre(sss( 1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout)88 CALL prihre(sss(:,:),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout) 118 89 ENDIF 119 CALL flinclo(numsss)120 90 121 91 ENDIF -
trunk/NEMO/OPA_SRC/DTA/dtasst.F90
r392 r473 27 27 #if defined key_dtasst 28 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtasst = .TRUE. !: sst data flag 29 INTEGER :: & 30 numsst , & !: logical unit for surface temperature data 31 ndaysst !: new day for Reynolds sst 32 CHARACTER (len=34) :: clname !: filename for daily SST 29 33 #else 30 34 LOGICAL , PUBLIC, PARAMETER :: lk_dtasst = .FALSE. !: sst data flag … … 71 75 !!---------------------------------------------------------------------- 72 76 !! * Modules used 73 USE io ipsl77 USE iom 74 78 75 79 !! * Arguments … … 77 81 78 82 !! * Local save 79 INTEGER, SAVE :: &80 ndaysst, & ! new day for Reynolds sst81 nyearsst ! new year for Reynolds sst82 83 83 84 !! * Local declarations 84 85 INTEGER :: ji, jj 85 INTEGER :: iprint 86 INTEGER :: iy, iday, idy 87 INTEGER :: istep(366) 88 INTEGER :: ipi, ipj, ipk 86 !!---------------------------------------------------------------------- 89 87 90 REAL(wp) :: zdate0, zdt, ztgel 91 REAL(wp) :: zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk) 92 CHARACTER (len=45) :: & 93 clname ! filename for daily SST 94 !!---------------------------------------------------------------------- 95 clname = 'sst_1d.nc' 96 #if defined key_agrif 97 if ( .NOT. Agrif_Root() ) then 98 clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 99 endif 100 #endif 88 ! -------------------- ! 89 ! First call kt=nit000 ! 90 ! -------------------- ! 91 101 92 IF( kt == nit000 ) THEN 102 IF(lwp) WRITE(numout,*) 93 94 ndaysst = 0 ! initializations 103 95 IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data' 104 IF(lwp) WRITE(numout,*) '~~~~~~~ read in file: ', clname105 sst(:,:) = 0.e0 ! required for extra halos in mpp 96 CALL iom_open ( 'sst_1d.nc', numsst ) 97 106 98 ENDIF 107 99 108 109 ! 0. initialization 110 ! ----------------- 111 112 ipi = jpiglo 113 ipj = jpjglo 114 ipk = jpk 115 116 IF( nleapy == 0 ) THEN 117 idy=365 118 ELSEIF( nleapy == 1 ) THEN 119 IF( MOD( nyear, 4 ) == 0 ) THEN 120 idy=366 121 ELSE 122 idy=365 123 ENDIF 124 ELSEIF( nleapy == 30 ) THEN 125 IF(lwp) WRITE(numout,*) 'dtasst : nleapy = 30 is not compatible' 126 IF(lwp) WRITE(numout,*) ' with existing files' 127 IF(lwp) WRITE(numout,*) 'WE STOP' 128 STOP 1234 129 ENDIF 130 131 132 ! 2. Open files if nyearsst 133 ! ------------------------- 134 135 IF( nyearsst /= nyear ) THEN 136 nyearsst = nyear 137 iprint = 1 138 139 ! 2.1 Define file name and record 140 141 ! Close/open file if new year 142 143 IF( nyearsst /= 0 ) CALL flinclo(numsst) 144 iy = nyear 145 IF(lwp) WRITE (numout,*) iy 146 IF(lwp) WRITE (numout,*) 'open sst file = ', clname 147 CALL FLUSH(numout) 148 149 CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj & 150 , ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsst ) 151 152 IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN 153 IF(lwp) WRITE(numout,*) 154 IF(lwp) WRITE(numout,*) 'problem with dimensions' 155 IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta 156 IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta 157 nstop = nstop + 1 158 ENDIF 159 IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt 160 ELSE 161 iprint = 0 162 ENDIF 163 164 165 ! 3. Read SST if new day 166 ! ------------------------- 100 ! ----------------- ! 101 ! Read daily file ! 102 ! ----------------- ! 167 103 168 104 ! Read daily SST … … 170 106 IF( ndaysst /= nday ) THEN 171 107 ndaysst = nday 172 iday = nday_year 173 174 CALL flinget( numsst, 'sst', jpidta, jpjdta, 1, idy, iday, & 175 iday, mig(1), nlci, mjg(1), nlcj, sst(1:nlci,1:nlcj) ) 176 108 109 CALL iom_get ( numsst, jpdom_data, 'sst', sst, ndaysst ) 110 177 111 IF ( kt == nit000 .AND. lwp ) THEN 178 112 WRITE(numout,*) ' ' … … 180 114 WRITE(numout,*) ' ' 181 115 WRITE(numout,*) ' Surface temp day: ', ndastp 182 CALL prihre(sst( 1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout)116 CALL prihre(sst(:,:),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout) 183 117 ENDIF 184 118 … … 201 135 WRITE(numout,*) 202 136 WRITE(numout,*) 'Ice cover : ' 203 CALL prihre( rclice( 1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )137 CALL prihre( rclice(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) 204 138 ENDIF 205 139 … … 207 141 ! -------------- 208 142 209 IF( kt == nitend ) CALL flinclo(numsst) 210 CALL FLUSH(numout) 143 IF( kt == nitend ) CALL iom_close (numsst) 211 144 212 145 -
trunk/NEMO/OPA_SRC/DTA/dtatem.F90
r459 r473 9 9 !!---------------------------------------------------------------------- 10 10 !! dta_tem : read ocean temperature data 11 !!--- -------------------------------------------------------------------11 !!---l------------------------------------------------------------------- 12 12 !! * Modules used 13 13 USE oce ! ocean dynamics and tracers 14 14 USE dom_oce ! ocean space and time domain 15 15 USE in_out_manager ! I/O manager 16 USE phycst ! physical constants 16 17 USE daymod ! calendar 17 18 #if defined key_orca_lev10 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 #endif 18 21 IMPLICIT NONE 19 22 PRIVATE … … 28 31 29 32 !! * Module variables 30 CHARACTER (len=45) :: &31 cl_tdata32 33 INTEGER :: & 33 nlecte = 0, & ! switch for the first read 34 ntem1 , & ! first record used 35 ntem2 ! second record used 34 numtdt, & !: logical unit for data temperature 35 ntem1, ntem2 ! first and second record used 36 36 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 37 37 temdta ! temperature data at two consecutive times … … 75 75 !!---------------------------------------------------------------------- 76 76 !! * Modules used 77 USE io ipsl77 USE iom 78 78 79 79 !! * Arguments … … 81 81 82 82 !! * Local declarations 83 INTEGER, PARAMETER :: & 84 jpmois = 12 ! number of month 85 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 86 REAL(wp), DIMENSION(jpk,2) :: & 87 ztemdta ! auxiliary array for interpolation 88 83 INTEGER :: ji, jj, jl, jk, jkk ! dummy loop indicies 89 84 INTEGER :: & 90 imois, iman, itime, ik , & ! temporary integers 91 i15, ipi, ipj, ipk ! " " 85 imois, iman, i15 , ik ! temporary integers 92 86 # if defined key_tradmp 93 87 INTEGER :: & 94 88 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 95 89 # endif 96 97 INTEGER, DIMENSION(jpmois) :: istep 98 REAL(wp) :: zxy, zl, zdate0 99 REAL(wp), DIMENSION(jpi,jpj) :: zlon,zlat 100 REAL(wp), DIMENSION(jpk) :: zlev 90 REAL(wp) :: zxy, zl 91 #if defined key_orca_lev10 92 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 93 INTEGER :: ikr, ikw, ikt, jjk 94 REAL(wp) :: zfac 95 #endif 96 REAL(wp), DIMENSION(jpk,2) :: & 97 ztemdta ! auxiliary array for interpolation 101 98 !!---------------------------------------------------------------------- 102 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 ' 130 #if defined key_agrif 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 99 100 ! 0. Initialization 101 ! ----------------- 102 103 iman = INT( raamo ) 104 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 105 i15 = nday / 16 106 imois = nmonth + i15 - 1 107 IF( imois == 0 ) imois = iman 108 109 ! 1. First call kt=nit000 110 ! ----------------------- 111 112 IF( kt == nit000 ) THEN 113 114 ntem1= 0 ! initializations 115 IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 116 CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 117 118 ENDIF 119 120 121 ! 2. Read monthly file 122 ! ------------------- 123 124 IF( kt == nit000 .OR. imois /= ntem1 ) THEN 125 126 ! Calendar computation 127 128 ntem1 = imois ! first file record used 129 ntem2 = ntem1 + 1 ! last file record used 130 ntem1 = MOD( ntem1, iman ) 131 IF( ntem1 == 0 ) ntem1 = iman 132 ntem2 = MOD( ntem2, iman ) 133 IF( ntem2 == 0 ) ntem2 = iman 134 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 135 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 136 137 ! Read monthly temperature data Levitus 138 139 #if defined key_orca_lev10 140 if (lk_zps) stop 141 ztem(:,:,:,:) = 0. 142 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 143 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 144 #else 145 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 146 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 147 #endif 148 149 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 151 IF(lwp) WRITE(numout,*) 152 195 153 #if defined key_tradmp 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 249 #endif 250 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) 318 319 END SUBROUTINE dta_tem 154 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 155 156 ! ! ======================= 157 ! ! ORCA_R2 configuration 158 ! ! ======================= 159 160 ij0 = 101 ; ij1 = 109 161 ii0 = 141 ; ii1 = 155 162 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 163 DO ji = mi0(ii0), mi1(ii1) 164 #if defined key_orca_lev10 165 ztem( ji,jj, 13:13 ,:) = ztem (ji,jj, 13:13 ,:) - 0.20 166 ztem (ji,jj, 14:15 ,:) = ztem (ji,jj, 14:15 ,:) - 0.35 167 ztem (ji,jj, 16:25 ,:) = ztem (ji,jj, 16:25 ,:) - 0.40 168 #else 169 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 170 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 171 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 172 #endif 173 END DO 174 END DO 175 176 IF( n_cla == 0 ) THEN 177 ! ! Reduced temperature at Red Sea 178 ij0 = 87 ; ij1 = 96 179 ii0 = 148 ; ii1 = 160 180 #if defined key_orca_lev10 181 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 182 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 183 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 184 #else 185 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 186 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 187 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 188 #endif 189 ELSE 190 il0 = 138 ; il1 = 138 191 ij0 = 101 ; ij1 = 102 192 ii0 = 139 ; ii1 = 139 193 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Gibraltar 194 DO jj = mj0(ij0), mj1(ij1) 195 DO ji = mi0(ii0), mi1(ii1) 196 #if defined key_orca_lev10 197 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 198 #else 199 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 200 #endif 201 END DO 202 END DO 203 END DO 204 il0 = 164 ; il1 = 164 205 ij0 = 88 ; ij1 = 88 206 ii0 = 161 ; ii1 = 163 207 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Bab el Mandeb 208 DO jj = mj0(ij0), mj1(ij1) 209 DO ji = mi0(ii0), mi1(ii1) 210 #if defined key_orca_lev10 211 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 212 #else 213 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 214 #endif 215 END DO 216 END DO 217 ij0 = 87 ; ij1 = 87 218 DO jj = mj0(ij0), mj1(ij1) 219 DO ji = mi0(ii0), mi1(ii1) 220 #if defined key_orca_lev10 221 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 222 #else 223 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 224 #endif 225 END DO 226 END DO 227 END DO 228 ENDIF 229 230 ENDIF 231 #endif 232 233 #if defined key_orca_lev10 234 ! interpolate from 31 to 301 level the ztem field result in temdta 235 DO jl = 1, 2 236 DO jjk = 1, 5 237 temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 238 END DO 239 DO jk = 1, jpk-20,10 240 ik = jk+5 241 ikr = INT(jk/10) + 1 242 ikw = (ikr-1) *10 + 1 243 ikt = ikw + 5 244 DO jjk=ikt,ikt+9 245 zfac = ( gdept(jjk ) - gdepw(ikt) ) / ( gdepw(ikt+10) - gdepw(ikt) ) 246 temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 247 END DO 248 END DO 249 DO jjk = jpk-5, jpk 250 temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 251 END DO 252 ! fill the overlap areas 253 CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 254 END DO 255 #endif 256 257 IF( ln_sco ) THEN 258 DO jl = 1, 2 259 DO jj = 1, jpj ! interpolation of temperatures 260 DO ji = 1, jpi 261 DO jk = 1, jpk 262 zl=fsdept(ji,jj,jk) 263 IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) 264 IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(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 ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & 268 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 269 & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 270 ENDIF 271 END DO 272 END DO 273 DO jk = 1, jpkm1 274 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 275 END DO 276 temdta(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 temperature data interpolated to s-coordinate' 283 IF(lwp) WRITE(numout,*) 284 285 ELSE 286 287 ! ! Mask 288 DO jl = 1, 2 289 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 290 temdta(:,:,jpk,jl) = 0. 291 IF( ln_zps ) THEN ! z-coord. with partial steps 292 DO jj = 1, jpj ! interpolation of temperature at the last level 293 DO ji = 1, jpi 294 ik = mbathy(ji,jj) - 1 295 IF( ik > 2 ) THEN 296 zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 297 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 298 ENDIF 299 END DO 300 END DO 301 ENDIF 302 END DO 303 304 ENDIF 305 306 IF(lwp) THEN 307 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 308 WRITE(numout,*) 309 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 310 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 311 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 312 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 313 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 314 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 315 ENDIF 316 ENDIF 317 318 319 ! 2. At every time step compute temperature data 320 ! ---------------------------------------------- 321 322 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 323 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 324 325 ! Close the file 326 ! -------------- 327 328 IF( kt == nitend ) CALL iom_close (numtdt) 329 330 END SUBROUTINE dta_tem 320 331 321 332 #else
Note: See TracChangeset
for help on using the changeset viewer.
