Changeset 1806 for branches/DEV_r1784_3DF/NEMO/OPA_SRC/DTA/dtatem.F90
- Timestamp:
- 2010-02-24T17:40:02+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_3DF/NEMO/OPA_SRC/DTA/dtatem.F90
r1715 r1806 13 13 USE oce ! ocean dynamics and tracers 14 14 USE dom_oce ! ocean space and time domain 15 USE fldread ! read input fields 15 16 USE in_out_manager ! I/O manager 16 17 USE phycst ! physical constants … … 26 27 !! * Shared module variables 27 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 29 t_dta !: temperature data at given time-step 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta !: temperature data at given time-step 30 30 31 31 !! * Module variables 32 INTEGER :: & 33 numtdt, & !: logical unit for data temperature 34 ntem1, ntem2 ! first and second record used 35 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 36 temdta ! temperature data at two consecutive times 32 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read) 37 33 38 34 !! * Substitutions … … 73 69 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 74 70 !!---------------------------------------------------------------------- 75 !! * Modules used76 USE iom77 78 71 !! * Arguments 79 72 INTEGER, INTENT( in ) :: kt ! ocean time-step 80 73 81 74 !! * Local declarations 82 INTEGER :: ji, jj, j l, jk, jkk ! dummy loop indicies75 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 83 76 INTEGER :: & 84 imois, iman, i15 , ik ! temporary integers 85 # if defined key_tradmp 77 imois, iman, i15 , ik ! temporary integers 78 INTEGER :: ierror 79 #if defined key_tradmp 86 80 INTEGER :: & 87 81 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 88 # 82 #endif 89 83 REAL(wp) :: zxy, zl 90 84 #if defined key_orca_lev10 91 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem85 !!!REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 92 86 INTEGER :: ikr, ikw, ikt, jjk 93 87 REAL(wp) :: zfac 94 88 #endif 95 REAL(wp), DIMENSION(jpk ,2) :: &89 REAL(wp), DIMENSION(jpk) :: & 96 90 ztemdta ! auxiliary array for interpolation 91 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 92 TYPE(FLD_N) :: sn_tem 93 LOGICAL , SAVE :: linit_tem = .FALSE. 97 94 !!---------------------------------------------------------------------- 98 99 ! 0. Initialization 100 ! ----------------- 101 102 iman = INT( raamo ) 103 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 104 i15 = nday / 16 105 imois = nmonth + i15 - 1 106 IF( imois == 0 ) imois = iman 107 108 ! 1. First call kt=nit000 95 NAMELIST/namdta_tem/cn_dir,sn_tem 96 97 ! 1. Initialization 109 98 ! ----------------------- 110 99 111 IF( kt == nit000 ) THEN 112 113 ntem1= 0 ! initializations 114 IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 115 CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 116 117 ENDIF 118 100 IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN 101 102 ! ! set file information 103 cn_dir = './' ! directory in which the model is executed 104 ! ... default values (NB: frequency positive => hours, negative => months) 105 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 106 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 107 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' ) 108 109 REWIND( numnam ) ! ... read in namlist namdta_tem 110 READ( numnam, namdta_tem ) 111 112 IF(lwp) THEN ! control print 113 WRITE(numout,*) 114 WRITE(numout,*) 'dta_tem : Temperature Climatology ' 115 WRITE(numout,*) '~~~~~~~ ' 116 ENDIF 117 ALLOCATE( sf_tem(1), STAT=ierror ) 118 IF( ierror > 0 ) THEN 119 CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN 120 ENDIF 121 122 #if defined key_orca_lev10 123 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta) ) 124 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 125 #else 126 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk) ) 127 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 128 #endif 129 ! fill sf_tem with sn_tem and control print 130 CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 131 linit_tem = .TRUE. 132 133 ENDIF 119 134 120 135 ! 2. Read monthly file 121 136 ! ------------------- 122 123 IF( kt == nit000 .OR. imois /= ntem1 ) THEN 124 125 ! Calendar computation 126 127 ntem1 = imois ! first file record used 128 ntem2 = ntem1 + 1 ! last file record used 129 ntem1 = MOD( ntem1, iman ) 130 IF( ntem1 == 0 ) ntem1 = iman 131 ntem2 = MOD( ntem2, iman ) 132 IF( ntem2 == 0 ) ntem2 = iman 133 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 134 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 135 136 ! Read monthly temperature data Levitus 137 138 #if defined key_orca_lev10 139 if (ln_zps) stop 140 ztem(:,:,:,:) = 0. 141 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 142 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 143 #else 144 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 145 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 146 #endif 147 148 IF(lwp) WRITE(numout,*) 149 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 150 IF(lwp) WRITE(numout,*) 137 138 CALL fld_read( kt, 1, sf_tem ) 139 140 IF( lwp .AND. kt==nn_it000 )THEN 141 WRITE(numout,*) 142 WRITE(numout,*) ' read Levitus temperature ok' 143 WRITE(numout,*) 144 ENDIF 151 145 152 146 #if defined key_tradmp 153 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 154 155 ! ! ======================= 156 ! ! ORCA_R2 configuration 157 ! ! ======================= 158 ij0 = 101 ; ij1 = 109 159 ii0 = 141 ; ii1 = 155 160 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 161 DO ji = mi0(ii0), mi1(ii1) 162 #if defined key_orca_lev10 163 ztem( ji,jj, 13:13 ,:) = ztem (ji,jj, 13:13 ,:) - 0.20 164 ztem (ji,jj, 14:15 ,:) = ztem (ji,jj, 14:15 ,:) - 0.35 165 ztem (ji,jj, 16:25 ,:) = ztem (ji,jj, 16:25 ,:) - 0.40 147 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 148 149 ! ! ======================= 150 ! ! ORCA_R2 configuration 151 ! ! ======================= 152 ij0 = 101 ; ij1 = 109 153 ii0 = 141 ; ii1 = 155 154 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 155 DO ji = mi0(ii0), mi1(ii1) 156 sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20 157 sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 158 sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40 159 END DO 160 END DO 161 162 IF( n_cla == 1 ) THEN 163 ! ! New temperature profile at Gibraltar 164 il0 = 138 ; il1 = 138 165 ij0 = 101 ; ij1 = 102 166 ii0 = 139 ; ii1 = 139 167 DO jl = mi0(il0), mi1(il1) 168 DO jj = mj0(ij0), mj1(ij1) 169 DO ji = mi0(ii0), mi1(ii1) 170 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 171 END DO 172 END DO 173 END DO 174 ! ! New temperature profile at Bab el Mandeb 175 il0 = 164 ; il1 = 164 176 ij0 = 87 ; ij1 = 88 177 ii0 = 161 ; ii1 = 163 178 DO jl = mi0(il0), mi1(il1) 179 DO jj = mj0(ij0), mj1(ij1) 180 DO ji = mi0(ii0), mi1(ii1) 181 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 182 END DO 183 END DO 184 END DO 185 ! 186 ELSE 187 ! ! Reduced temperature at Red Sea 188 ij0 = 87 ; ij1 = 96 189 ii0 = 148 ; ii1 = 160 190 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0 191 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5 192 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0 193 ENDIF 194 ! 195 ENDIF 196 #endif 197 198 #if defined key_orca_lev10 199 DO jjk = 1, 5 200 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1) 201 END DO 202 DO jk = 1, jpk-20,10 203 ik = jk+5 204 ikr = INT(jk/10) + 1 205 ikw = (ikr-1) *10 + 1 206 ikt = ikw + 5 207 DO jjk=ikt,ikt+9 208 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 209 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac 210 END DO 211 END DO 212 DO jjk = jpk-5, jpk 213 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1) 214 END DO 215 ! fill the overlap areas 216 CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0') 166 217 #else 167 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 168 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 169 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 170 #endif 171 END DO 172 END DO 173 174 IF( n_cla == 1 ) THEN 175 ! ! New temperature profile at Gibraltar 176 il0 = 138 ; il1 = 138 177 ij0 = 101 ; ij1 = 102 178 ii0 = 139 ; ii1 = 139 179 DO jl = mi0(il0), mi1(il1) 180 DO jj = mj0(ij0), mj1(ij1) 181 DO ji = mi0(ii0), mi1(ii1) 182 #if defined key_orca_lev10 183 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 184 #else 185 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 186 #endif 187 END DO 218 t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 219 #endif 220 221 IF( ln_sco ) THEN 222 DO jj = 1, jpj ! interpolation of temperatures 223 DO ji = 1, jpi 224 DO jk = 1, jpk 225 zl=fsdept_0(ji,jj,jk) 226 IF(zl < gdept_0(1)) ztemdta(jk) = t_dta(ji,jj,1) 227 IF(zl > gdept_0(jpk)) ztemdta(jk) = t_dta(ji,jj,jpkm1) 228 DO jkk = 1, jpkm1 229 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 230 ztemdta(jk) = t_dta(ji,jj,jkk) & 231 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 232 & * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk)) 233 ENDIF 188 234 END DO 189 235 END DO 190 ! ! New temperature profile at Bab el Mandeb 191 il0 = 164 ; il1 = 164 192 ij0 = 87 ; ij1 = 88 193 ii0 = 161 ; ii1 = 163 194 DO jl = mi0(il0), mi1(il1) 195 DO jj = mj0(ij0), mj1(ij1) 196 DO ji = mi0(ii0), mi1(ii1) 197 #if defined key_orca_lev10 198 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 199 #else 200 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 201 #endif 202 END DO 203 END DO 204 END DO 205 ! 206 ELSE 207 ! ! Reduced temperature at Red Sea 208 ij0 = 87 ; ij1 = 96 209 ii0 = 148 ; ii1 = 160 210 #if defined key_orca_lev10 211 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 212 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 213 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 214 #else 215 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 216 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 217 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 218 #endif 219 ENDIF 220 ! 221 ENDIF 222 #endif 223 224 #if defined key_orca_lev10 225 ! interpolate from 31 to 301 level the ztem field result in temdta 226 DO jl = 1, 2 227 DO jjk = 1, 5 228 temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 229 END DO 230 DO jk = 1, jpk-20,10 231 ik = jk+5 232 ikr = INT(jk/10) + 1 233 ikw = (ikr-1) *10 + 1 234 ikt = ikw + 5 235 DO jjk=ikt,ikt+9 236 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 237 temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 238 END DO 239 END DO 240 DO jjk = jpk-5, jpk 241 temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 242 END DO 243 ! fill the overlap areas 244 CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 245 END DO 246 #endif 247 248 IF( ln_sco ) THEN 249 DO jl = 1, 2 250 DO jj = 1, jpj ! interpolation of temperatures 251 DO ji = 1, jpi 252 DO jk = 1, jpk 253 zl=fsdept_0(ji,jj,jk) 254 IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) 255 IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(ji,jj,jpkm1,jl) 256 DO jkk = 1, jpkm1 257 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 258 ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & 259 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 260 & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 261 ENDIF 262 END DO 263 END DO 264 DO jk = 1, jpkm1 265 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 266 END DO 267 temdta(ji,jj,jpk,jl) = 0.0 268 END DO 269 END DO 270 END DO 271 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 274 IF(lwp) WRITE(numout,*) 275 276 ELSE 277 278 ! ! Mask 279 DO jl = 1, 2 280 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 281 temdta(:,:,jpk,jl) = 0. 282 IF( ln_zps ) THEN ! z-coord. with partial steps 283 DO jj = 1, jpj ! interpolation of temperature at the last level 284 DO ji = 1, jpi 285 ik = mbathy(ji,jj) - 1 286 IF( ik > 2 ) THEN 287 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 288 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 289 ENDIF 290 END DO 291 END DO 292 ENDIF 293 END DO 294 295 ENDIF 296 297 IF(lwp) THEN 298 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 236 DO jk = 1, jpkm1 237 t_dta(ji,jj,jk) = ztemdta(jk) 238 END DO 239 t_dta(ji,jj,jpk) = 0.0 240 END DO 241 END DO 242 243 IF( lwp .AND. kt==nn_it000 )THEN 299 244 WRITE(numout,*) 300 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 301 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 302 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 303 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 304 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 305 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 306 ENDIF 307 ENDIF 308 309 310 ! 2. At every time step compute temperature data 311 ! ---------------------------------------------- 312 313 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 314 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 315 316 ! Close the file 317 ! -------------- 318 319 IF( kt == nitend ) CALL iom_close (numtdt) 320 321 END SUBROUTINE dta_tem 245 WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 246 WRITE(numout,*) 247 ENDIF 248 249 ELSE 250 ! ! Mask 251 t_dta(:,:,: ) = t_dta(:,:,:) * tmask(:,:,:) 252 t_dta(:,:,jpk) = 0. 253 IF( ln_zps ) THEN ! z-coord. with partial steps 254 DO jj = 1, jpj ! interpolation of temperature at the last level 255 DO ji = 1, jpi 256 ik = mbathy(ji,jj) - 1 257 IF( ik > 2 ) THEN 258 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 259 t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 260 ENDIF 261 END DO 262 END DO 263 ENDIF 264 265 ENDIF 266 267 IF( lwp .AND. kt==nn_it000 ) THEN 268 WRITE(numout,*) ' temperature Levitus ' 269 WRITE(numout,*) 270 WRITE(numout,*)' level = 1' 271 CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 272 WRITE(numout,*)' level = ', jpk/2 273 CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 274 WRITE(numout,*)' level = ', jpkm1 275 CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 276 ENDIF 277 278 END SUBROUTINE dta_tem 322 279 323 280 #else
Note: See TracChangeset
for help on using the changeset viewer.
