Changeset 440 for trunk/NEMO/OPA_SRC/DTA/dtatem.F90
- Timestamp:
- 2006-04-19T16:43:17+02:00 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DTA/dtatem.F90
r434 r440 98 98 !!---------------------------------------------------------------------- 99 99 100 IF( cp_cfg /= 'gyre' ) THEN 101 102 ! 0. Initialization 103 ! ----------------- 104 105 iman = jpmois 106 i15 = nday / 16 107 imois = nmonth + i15 - 1 108 IF( imois == 0 ) imois = iman 109 110 itime = jpmois 111 ipi = jpiglo 112 ipj = jpjglo 113 ipk = jpk 114 115 ! 1. First call kt=nit000 116 ! ----------------------- 117 118 IF( kt == nit000 .AND. nlecte == 0 ) THEN 119 ntem1 = 0 120 IF(lwp) WRITE(numout,*) 121 IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 122 IF(lwp) WRITE(numout,*) ' ~~~~~~' 123 IF(lwp) WRITE(numout,*) ' NetCDF FORMAT' 124 IF(lwp) WRITE(numout,*) 125 126 ! open file 127 128 cl_tdata = 'data_1m_potential_temperature_nomask ' 100 ! 0. Initialization 101 ! ----------------- 102 103 iman = jpmois 104 i15 = nday / 16 105 imois = nmonth + i15 - 1 106 IF( imois == 0 ) imois = iman 107 108 itime = jpmois 109 ipi = jpiglo 110 ipj = jpjglo 111 ipk = jpk 112 113 ! 1. First call kt=nit000 114 ! ----------------------- 115 116 IF( kt == nit000 .AND. nlecte == 0 ) THEN 117 ntem1 = 0 118 IF(lwp) WRITE(numout,*) 119 IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 120 IF(lwp) WRITE(numout,*) ' ~~~~~~' 121 IF(lwp) WRITE(numout,*) ' NetCDF FORMAT' 122 IF(lwp) WRITE(numout,*) 123 124 ! open file 125 126 cl_tdata = 'data_1m_potential_temperature_nomask ' 129 127 #if defined key_agrif 130 131 132 133 #endif 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 192 193 128 if ( .NOT. Agrif_Root() ) then 129 cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 130 endif 131 #endif 132 CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1), nlcj & 133 & , .false. , ipi , ipj , ipk , zlon & 134 & , zlat , zlev , itime, istep , zdate0 & 135 & , rdt , numtdt ) 136 137 ! title, dimensions and tests 138 139 IF( itime /= jpmois ) THEN 140 IF(lwp) THEN 141 WRITE(numout,*) 142 WRITE(numout,*) 'problem with time coordinates' 143 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 144 ENDIF 145 STOP 'dtatem' 146 ENDIF 147 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 148 IF(lwp) THEN 149 WRITE(numout,*) 150 WRITE(numout,*) 'problem with dimensions' 151 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 152 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 153 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 154 ENDIF 155 STOP 'dtatem' 156 ENDIF 157 IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 158 159 ENDIF 160 161 162 ! 2. Read monthly file 163 ! ------------------- 164 165 IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 166 nlecte = 1 167 168 ! Calendar computation 169 170 ntem1 = imois ! first file record used 171 ntem2 = ntem1 + 1 ! last file record used 172 ntem1 = MOD( ntem1, iman ) 173 IF( ntem1 == 0 ) ntem1 = iman 174 ntem2 = MOD( ntem2, iman ) 175 IF( ntem2 == 0 ) ntem2 = iman 176 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 177 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 178 179 ! Read monthly temperature data Levitus 180 181 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 182 , jpmois, ntem1 , ntem1 , mig(1), nlci & 183 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,1) ) 184 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 185 , jpmois, ntem2 , ntem2 , mig(1), nlci & 186 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,2) ) 187 188 IF(lwp) WRITE(numout,*) 189 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 190 IF(lwp) WRITE(numout,*) 191 194 192 #if defined key_tradmp 195 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 196 197 ! ! ======================= 198 ! ! ORCA_R2 configuration 199 ! ! ======================= 200 201 ij0 = 101 ; ij1 = 109 202 ii0 = 141 ; ii1 = 155 203 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 204 DO ji = mi0(ii0), mi1(ii1) 205 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 206 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 207 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 208 END DO 209 END DO 210 211 IF( n_cla == 0 ) THEN 212 ! ! Reduced temperature at Red Sea 213 ij0 = 87 ; ij1 = 96 214 ii0 = 148 ; ii1 = 160 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 ELSE 219 il0 = 138 ; il1 = 138 220 ij0 = 101 ; ij1 = 102 221 ii0 = 139 ; ii1 = 139 222 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Gibraltar 223 DO jj = mj0(ij0), mj1(ij1) 224 DO ji = mi0(ii0), mi1(ii1) 225 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 226 END DO 193 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 194 195 ! ! ======================= 196 ! ! ORCA_R2 configuration 197 ! ! ======================= 198 199 ij0 = 101 ; ij1 = 109 200 ii0 = 141 ; ii1 = 155 201 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 202 DO ji = mi0(ii0), mi1(ii1) 203 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 204 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 205 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 206 END DO 207 END DO 208 209 IF( n_cla == 0 ) THEN 210 ! ! Reduced temperature at Red Sea 211 ij0 = 87 ; ij1 = 96 212 ii0 = 148 ; ii1 = 160 213 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 214 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 215 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 216 ELSE 217 il0 = 138 ; il1 = 138 218 ij0 = 101 ; ij1 = 102 219 ii0 = 139 ; ii1 = 139 220 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Gibraltar 221 DO jj = mj0(ij0), mj1(ij1) 222 DO ji = mi0(ii0), mi1(ii1) 223 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 227 224 END DO 228 225 END DO 229 il0 = 164 ; il1 = 164230 ij0 = 88 ; ij1 = 88231 ii0 = 161 ; ii1 = 163232 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Bab el Mandeb233 DO jj = mj0(ij0), mj1(ij1)234 DO ji = mi0(ii0), mi1(ii1)235 temdta(ji,jj,:,:) = temdta(jl,jj,:,:)236 END DO226 END DO 227 il0 = 164 ; il1 = 164 228 ij0 = 88 ; ij1 = 88 229 ii0 = 161 ; ii1 = 163 230 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Bab el Mandeb 231 DO jj = mj0(ij0), mj1(ij1) 232 DO ji = mi0(ii0), mi1(ii1) 233 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 237 234 END DO 238 ij0 = 87 ; ij1 = 87239 DO jj = mj0(ij0), mj1(ij1)240 DO ji = mi0(ii0), mi1(ii1)241 temdta(ji,jj,:,:) = temdta(jl,jj,:,:)242 END DO235 END DO 236 ij0 = 87 ; ij1 = 87 237 DO jj = mj0(ij0), mj1(ij1) 238 DO ji = mi0(ii0), mi1(ii1) 239 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 243 240 END DO 244 241 END DO 245 ENDIF 246 247 ENDIF 242 END DO 243 ENDIF 244 245 ENDIF 248 246 #endif 249 247 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 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 278 276 279 277 280 ! 2. At every time step compute temperature data 281 ! ---------------------------------------------- 282 283 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 284 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 285 286 ENDIF 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 287 284 288 285 END SUBROUTINE dta_tem
Note: See TracChangeset
for help on using the changeset viewer.