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