Changeset 434 for trunk/NEMO/OPA_SRC/DTA
- Timestamp:
- 2006-04-10T17:46:12+02:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DTA
- Files:
-
- 1 added
- 2 edited
-
dtasal.F90 (modified) (2 diffs)
-
dtasss.F90 (added)
-
dtatem.F90 (modified) (1 diff)
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 -
trunk/NEMO/OPA_SRC/DTA/dtatem.F90
r392 r434 98 98 !!---------------------------------------------------------------------- 99 99 100 cl_tdata = 'data_1m_potential_temperature_nomask ' 101 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 ' 102 129 #if defined key_agrif 103 if ( .NOT. Agrif_Root() ) then 104 cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 105 endif 106 #endif 107 108 ! 0. Initialization 109 ! ----------------- 110 111 iman = jpmois 112 i15 = nday / 16 113 imois = nmonth + i15 - 1 114 IF( imois == 0 ) imois = iman 115 116 itime = jpmois 117 ipi = jpiglo 118 ipj = jpjglo 119 ipk = jpk 120 121 ! 1. First call kt=nit000 122 ! ----------------------- 123 124 IF( kt == nit000 .AND. nlecte == 0 ) THEN 125 ntem1 = 0 126 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 128 IF(lwp) WRITE(numout,*) ' ~~~~~~' 129 IF(lwp) WRITE(numout,*) ' NetCDF FORMAT' 130 IF(lwp) WRITE(numout,*) 130 if ( .NOT. Agrif_Root() ) then 131 cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 132 endif 133 #endif 134 CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1), nlcj & 135 & , .false. , ipi , ipj , ipk , zlon & 136 & , zlat , zlev , itime, istep , zdate0 & 137 & , rdt , numtdt ) 138 139 ! title, dimensions and tests 140 141 IF( itime /= jpmois ) THEN 142 IF(lwp) THEN 143 WRITE(numout,*) 144 WRITE(numout,*) 'problem with time coordinates' 145 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 146 ENDIF 147 STOP 'dtatem' 148 ENDIF 149 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 150 IF(lwp) THEN 151 WRITE(numout,*) 152 WRITE(numout,*) 'problem with dimensions' 153 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 154 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 155 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 156 ENDIF 157 STOP 'dtatem' 158 ENDIF 159 IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 160 161 ENDIF 162 163 164 ! 2. Read monthly file 165 ! ------------------- 166 167 IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 168 nlecte = 1 169 170 ! Calendar computation 171 172 ntem1 = imois ! first file record used 173 ntem2 = ntem1 + 1 ! last file record used 174 ntem1 = MOD( ntem1, iman ) 175 IF( ntem1 == 0 ) ntem1 = iman 176 ntem2 = MOD( ntem2, iman ) 177 IF( ntem2 == 0 ) ntem2 = iman 178 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 179 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 180 181 ! Read monthly temperature data Levitus 182 183 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 184 , jpmois, ntem1 , ntem1 , mig(1), nlci & 185 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,1) ) 186 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 187 , jpmois, ntem2 , ntem2 , mig(1), nlci & 188 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,2) ) 189 190 IF(lwp) WRITE(numout,*) 191 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 192 IF(lwp) WRITE(numout,*) 193 194 #if defined key_tradmp 195 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 131 196 132 ! open file 133 134 CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1), nlcj & 135 , .false. , ipi , ipj , ipk , zlon & 136 , zlat , zlev , itime, istep , zdate0 & 137 , rdt , numtdt ) 138 139 ! title, dimensions and tests 140 141 IF( itime /= jpmois ) THEN 142 IF(lwp) THEN 143 WRITE(numout,*) 144 WRITE(numout,*) 'problem with time coordinates' 145 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 146 ENDIF 147 STOP 'dtatem' 148 ENDIF 149 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 150 IF(lwp) THEN 151 WRITE(numout,*) 152 WRITE(numout,*) 'problem with dimensions' 153 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 154 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 155 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 156 ENDIF 157 STOP 'dtatem' 158 ENDIF 159 IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 160 161 ENDIF 162 163 164 ! 2. Read monthly file 165 ! ------------------- 166 167 IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 168 nlecte = 1 169 170 ! Calendar computation 171 172 ntem1 = imois ! first file record used 173 ntem2 = ntem1 + 1 ! last file record used 174 ntem1 = MOD( ntem1, iman ) 175 IF( ntem1 == 0 ) ntem1 = iman 176 ntem2 = MOD( ntem2, iman ) 177 IF( ntem2 == 0 ) ntem2 = iman 178 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 179 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 180 181 ! Read monthly temperature data Levitus 182 183 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 184 , jpmois, ntem1 , ntem1 , mig(1), nlci & 185 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,1) ) 186 CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk & 187 , jpmois, ntem2 , ntem2 , mig(1), nlci & 188 , mjg(1), nlcj , temdta(1:nlci,1:nlcj,1:jpk,2) ) 189 190 IF(lwp) WRITE(numout,*) 191 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 192 IF(lwp) WRITE(numout,*) 193 194 # 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 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 208 209 END DO 209 END DO210 211 IF( n_cla == 0 ) THEN212 ! ! Reduced temperature at Red Sea213 ij0 = 87 ; ij1 = 96214 ii0 = 148 ; ii1 = 160215 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0216 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5217 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0218 ELSE219 il0 = 138 ; il1 = 138220 ij0 = 101 ; ij1 = 102221 ii0 = 139 ; ii1 = 139222 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Gibraltar223 DO jj = mj0(ij0), mj1(ij1)224 DO ji = mi0(ii0), mi1(ii1)225 temdta(ji,jj,:,:) = temdta(jl,jj,:,:)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 226 227 END DO 227 228 END DO 228 END DO 229 il0 = 164 ; il1 = 164 230 ij0 = 88 ; ij1 = 88 231 ii0 = 161 ; ii1 = 163 232 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Bab el Mandeb 233 DO jj = mj0(ij0), mj1(ij1) 234 DO ji = mi0(ii0), mi1(ii1) 235 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 229 il0 = 164 ; il1 = 164 230 ij0 = 88 ; ij1 = 88 231 ii0 = 161 ; ii1 = 163 232 DO jl = mi0(il0), mi1(il1) ! New temperature profile at Bab el Mandeb 233 DO jj = mj0(ij0), mj1(ij1) 234 DO ji = mi0(ii0), mi1(ii1) 235 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 236 END DO 237 END DO 238 ij0 = 87 ; ij1 = 87 239 DO jj = mj0(ij0), mj1(ij1) 240 DO ji = mi0(ii0), mi1(ii1) 241 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 242 END DO 236 243 END DO 237 244 END DO 238 ij0 = 87 ; ij1 = 87 239 DO jj = mj0(ij0), mj1(ij1) 240 DO ji = mi0(ii0), mi1(ii1) 241 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 245 ENDIF 246 247 ENDIF 248 #endif 249 250 ! ! Mask 251 DO jl = 1, 2 252 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 253 temdta(:,:,jpk,jl) = 0. 254 IF( lk_zps ) THEN ! z-coord. with partial steps 255 DO jj = 1, jpj ! interpolation of temperature at the last level 256 DO ji = 1, jpi 257 ik = mbathy(ji,jj) - 1 258 IF( ik > 2 ) THEN 259 zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 260 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 261 ENDIF 242 262 END DO 243 263 END DO 244 END DO 264 ENDIF 265 END DO 266 267 IF(lwp) THEN 268 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 269 WRITE(numout,*) 270 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 271 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 272 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 273 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 274 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 275 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 245 276 ENDIF 246 247 277 ENDIF 248 # endif 249 250 ! ! Mask 251 DO jl = 1, 2 252 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 253 temdta(:,:,jpk,jl) = 0. 254 IF( lk_zps ) THEN ! z-coord. with partial steps 255 DO jj = 1, jpj ! interpolation of temperature at the last level 256 DO ji = 1, jpi 257 ik = mbathy(ji,jj) - 1 258 IF( ik > 2 ) THEN 259 zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 260 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 261 ENDIF 262 END DO 263 END DO 264 ENDIF 265 END DO 266 267 IF(lwp) THEN 268 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 269 WRITE(numout,*) 270 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 271 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 272 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 273 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 274 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 275 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 276 ENDIF 278 279 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 277 286 ENDIF 278 279 280 ! 2. At every time step compute temperature data281 ! ----------------------------------------------282 283 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.284 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)285 287 286 288 END SUBROUTINE dta_tem
Note: See TracChangeset
for help on using the changeset viewer.
