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