Changeset 4272
- Timestamp:
- Sep 21, 2022, 3:12:14 PM (20 months ago)
- Location:
- LMDZ6/trunk/libf/phylmd/dyn1d
- Files:
-
- 2 edited
-
mod_1D_cases_read2.F90 (modified) (10 diffs)
-
mod_1D_cases_read_std.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read2.F90
r4271 r4272 5 5 6 6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 7 !Declarations specifiques au cas standard8 9 ! Discr?tisation10 11 12 13 !profils environnementaux14 15 16 17 18 19 20 21 22 !forcing23 24 25 26 27 28 29 30 31 32 33 !champs interpoles34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 7 !Declarations specifiques au cas standard 8 character*80 :: fich_cas 9 ! Discr?tisation 10 integer nlev_cas, nt_cas 11 12 13 !profils environnementaux 14 real, allocatable:: plev_cas(:,:),plevh_cas(:) 15 real, allocatable:: ap_cas(:),bp_cas(:) 16 17 real, allocatable:: z_cas(:,:),zh_cas(:) 18 real, allocatable:: t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:) 19 real, allocatable:: th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:) 20 real, allocatable:: u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:) 21 22 !forcing 23 real, allocatable:: ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:) 24 real, allocatable:: hth_cas(:,:),vth_cas(:,:),dth_cas(:,:) 25 real, allocatable:: hq_cas(:,:),vq_cas(:,:),dq_cas(:,:) 26 real, allocatable:: hr_cas(:,:),vr_cas(:,:),dr_cas(:,:) 27 real, allocatable:: hu_cas(:,:),vu_cas(:,:),du_cas(:,:) 28 real, allocatable:: hv_cas(:,:),vv_cas(:,:),dv_cas(:,:) 29 real, allocatable:: ug_cas(:,:),vg_cas(:,:) 30 real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:) 31 real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tke_cas(:) 32 33 !champs interpoles 34 real, allocatable:: plev_prof_cas(:) 35 real, allocatable:: t_prof_cas(:) 36 real, allocatable:: theta_prof_cas(:) 37 real, allocatable:: thl_prof_cas(:) 38 real, allocatable:: thv_prof_cas(:) 39 real, allocatable:: q_prof_cas(:) 40 real, allocatable:: qv_prof_cas(:) 41 real, allocatable:: ql_prof_cas(:) 42 real, allocatable:: qi_prof_cas(:) 43 real, allocatable:: rh_prof_cas(:) 44 real, allocatable:: rv_prof_cas(:) 45 real, allocatable:: u_prof_cas(:) 46 real, allocatable:: v_prof_cas(:) 47 real, allocatable:: vitw_prof_cas(:) 48 real, allocatable:: omega_prof_cas(:) 49 real, allocatable:: ug_prof_cas(:) 50 real, allocatable:: vg_prof_cas(:) 51 real, allocatable:: ht_prof_cas(:) 52 real, allocatable:: hth_prof_cas(:) 53 real, allocatable:: hq_prof_cas(:) 54 real, allocatable:: vt_prof_cas(:) 55 real, allocatable:: vth_prof_cas(:) 56 real, allocatable:: vq_prof_cas(:) 57 real, allocatable:: dt_prof_cas(:) 58 real, allocatable:: dth_prof_cas(:) 59 real, allocatable:: dtrad_prof_cas(:) 60 real, allocatable:: dq_prof_cas(:) 61 real, allocatable:: hu_prof_cas(:) 62 real, allocatable:: hv_prof_cas(:) 63 real, allocatable:: vu_prof_cas(:) 64 real, allocatable:: vv_prof_cas(:) 65 real, allocatable:: du_prof_cas(:) 66 real, allocatable:: dv_prof_cas(:) 67 real, allocatable:: uw_prof_cas(:) 68 real, allocatable:: vw_prof_cas(:) 69 real, allocatable:: q1_prof_cas(:) 70 real, allocatable:: q2_prof_cas(:) 71 72 73 real lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tke_prof_cas 74 real o3_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas 75 76 76 77 77 78 78 CONTAINS 79 79 80 SUBROUTINE read_1D_cas81 80 SUBROUTINE read_1D_cas 81 implicit none 82 82 83 83 #include "netcdf.inc" 84 84 85 86 87 88 89 90 91 92 93 94 95 96 97 !.......................................................................98 99 100 101 102 103 104 !.......................................................................105 106 107 108 109 110 111 !.......................................................................112 113 114 115 116 117 118 !.......................................................................119 120 121 122 123 124 125 126 85 INTEGER nid,rid,ierr 86 INTEGER ii,jj 87 88 fich_cas='setup/cas.nc' 89 print*,'fich_cas ',fich_cas 90 ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid) 91 print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid 92 if (ierr.NE.NF_NOERR) then 93 write(*,*) 'ERROR: GROS Pb opening forcings nc file ' 94 write(*,*) NF_STRERROR(ierr) 95 stop "" 96 endif 97 !....................................................................... 98 ierr=NF_INQ_DIMID(nid,'lat',rid) 99 IF (ierr.NE.NF_NOERR) THEN 100 print*, 'Oh probleme lecture dimension lat' 101 ENDIF 102 ierr=NF_INQ_DIMLEN(nid,rid,ii) 103 print*,'OK1 nid,rid,lat',nid,rid,ii 104 !....................................................................... 105 ierr=NF_INQ_DIMID(nid,'lon',rid) 106 IF (ierr.NE.NF_NOERR) THEN 107 print*, 'Oh probleme lecture dimension lon' 108 ENDIF 109 ierr=NF_INQ_DIMLEN(nid,rid,jj) 110 print*,'OK2 nid,rid,lat',nid,rid,jj 111 !....................................................................... 112 ierr=NF_INQ_DIMID(nid,'lev',rid) 113 IF (ierr.NE.NF_NOERR) THEN 114 print*, 'Oh probleme lecture dimension zz' 115 ENDIF 116 ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas) 117 print*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas 118 !....................................................................... 119 ierr=NF_INQ_DIMID(nid,'time',rid) 120 print*,'nid,rid',nid,rid 121 nt_cas=0 122 IF (ierr.NE.NF_NOERR) THEN 123 stop 'probleme lecture dimension sens' 124 ENDIF 125 ierr=NF_INQ_DIMLEN(nid,rid,nt_cas) 126 print*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas 127 127 128 128 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 129 !profils moyens:130 131 132 133 134 135 136 137 !forcing138 139 140 141 142 143 144 145 146 147 148 149 150 151 !champs interpoles152 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 END SUBROUTINE read_1D_cas190 !**********************************************************************************************191 SUBROUTINE read2_1D_cas192 129 !profils moyens: 130 allocate(plev_cas(nlev_cas,nt_cas)) 131 allocate(z_cas(nlev_cas,nt_cas)) 132 allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas)) 133 allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas)) 134 allocate(u_cas(nlev_cas,nt_cas)) 135 allocate(v_cas(nlev_cas,nt_cas)) 136 137 !forcing 138 allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas)) 139 allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas)) 140 allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas)) 141 allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas)) 142 allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas)) 143 allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas)) 144 allocate(vitw_cas(nlev_cas,nt_cas)) 145 allocate(ug_cas(nlev_cas,nt_cas)) 146 allocate(vg_cas(nlev_cas,nt_cas)) 147 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas)) 148 allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)) 149 150 151 !champs interpoles 152 allocate(plev_prof_cas(nlev_cas)) 153 allocate(t_prof_cas(nlev_cas)) 154 allocate(q_prof_cas(nlev_cas)) 155 allocate(u_prof_cas(nlev_cas)) 156 allocate(v_prof_cas(nlev_cas)) 157 158 allocate(vitw_prof_cas(nlev_cas)) 159 allocate(ug_prof_cas(nlev_cas)) 160 allocate(vg_prof_cas(nlev_cas)) 161 allocate(ht_prof_cas(nlev_cas)) 162 allocate(hq_prof_cas(nlev_cas)) 163 allocate(hu_prof_cas(nlev_cas)) 164 allocate(hv_prof_cas(nlev_cas)) 165 allocate(vt_prof_cas(nlev_cas)) 166 allocate(vq_prof_cas(nlev_cas)) 167 allocate(vu_prof_cas(nlev_cas)) 168 allocate(vv_prof_cas(nlev_cas)) 169 allocate(dt_prof_cas(nlev_cas)) 170 allocate(dtrad_prof_cas(nlev_cas)) 171 allocate(dq_prof_cas(nlev_cas)) 172 allocate(du_prof_cas(nlev_cas)) 173 allocate(dv_prof_cas(nlev_cas)) 174 allocate(uw_prof_cas(nlev_cas)) 175 allocate(vw_prof_cas(nlev_cas)) 176 allocate(q1_prof_cas(nlev_cas)) 177 allocate(q2_prof_cas(nlev_cas)) 178 179 print*,'Allocations OK' 180 call read_cas2(nid,nlev_cas,nt_cas & 181 ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas & 182 ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas & 183 ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas & 184 ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas& 185 ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas) 186 print*,'Read cas OK' 187 188 189 END SUBROUTINE read_1D_cas 190 !********************************************************************************************** 191 SUBROUTINE read2_1D_cas 192 implicit none 193 193 194 194 #include "netcdf.inc" 195 195 196 197 198 199 200 201 202 203 204 205 206 207 208 !.......................................................................209 210 211 212 213 214 215 !.......................................................................216 217 218 219 220 221 222 !.......................................................................223 224 225 226 227 228 229 !.......................................................................230 231 232 233 234 235 236 196 INTEGER nid,rid,ierr 197 INTEGER ii,jj 198 199 fich_cas='setup/cas.nc' 200 print*,'fich_cas ',fich_cas 201 ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid) 202 print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid 203 if (ierr.NE.NF_NOERR) then 204 write(*,*) 'ERROR: GROS Pb opening forcings nc file ' 205 write(*,*) NF_STRERROR(ierr) 206 stop "" 207 endif 208 !....................................................................... 209 ierr=NF_INQ_DIMID(nid,'lat',rid) 210 IF (ierr.NE.NF_NOERR) THEN 211 print*, 'Oh probleme lecture dimension lat' 212 ENDIF 213 ierr=NF_INQ_DIMLEN(nid,rid,ii) 214 print*,'OK1 read2: nid,rid,lat',nid,rid,ii 215 !....................................................................... 216 ierr=NF_INQ_DIMID(nid,'lon',rid) 217 IF (ierr.NE.NF_NOERR) THEN 218 print*, 'Oh probleme lecture dimension lon' 219 ENDIF 220 ierr=NF_INQ_DIMLEN(nid,rid,jj) 221 print*,'OK2 read2: nid,rid,lat',nid,rid,jj 222 !....................................................................... 223 ierr=NF_INQ_DIMID(nid,'nlev',rid) 224 IF (ierr.NE.NF_NOERR) THEN 225 print*, 'Oh probleme lecture dimension nlev' 226 ENDIF 227 ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas) 228 print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas 229 !....................................................................... 230 ierr=NF_INQ_DIMID(nid,'time',rid) 231 nt_cas=0 232 IF (ierr.NE.NF_NOERR) THEN 233 stop 'Oh probleme lecture dimension time' 234 ENDIF 235 ierr=NF_INQ_DIMLEN(nid,rid,nt_cas) 236 print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas 237 237 238 238 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 239 !profils moyens:240 241 242 243 244 245 246 247 248 !forcing249 250 251 252 253 254 255 256 257 258 259 260 261 262 !champs interpoles263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 END SUBROUTINE read2_1D_cas316 317 !**********************************************************************************************318 SUBROUTINE old_read_SCM_cas319 239 !profils moyens: 240 allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1)) 241 allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1)) 242 allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1)) 243 allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), & 244 qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas)) 245 allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas)) 246 allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)) 247 248 !forcing 249 allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas)) 250 allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas)) 251 allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas)) 252 allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas)) 253 allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas)) 254 allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas)) 255 allocate(ug_cas(nlev_cas,nt_cas)) 256 allocate(vg_cas(nlev_cas,nt_cas)) 257 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas)) 258 allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)) 259 260 261 262 !champs interpoles 263 allocate(plev_prof_cas(nlev_cas)) 264 allocate(t_prof_cas(nlev_cas)) 265 allocate(theta_prof_cas(nlev_cas)) 266 allocate(thl_prof_cas(nlev_cas)) 267 allocate(thv_prof_cas(nlev_cas)) 268 allocate(q_prof_cas(nlev_cas)) 269 allocate(qv_prof_cas(nlev_cas)) 270 allocate(ql_prof_cas(nlev_cas)) 271 allocate(qi_prof_cas(nlev_cas)) 272 allocate(rh_prof_cas(nlev_cas)) 273 allocate(rv_prof_cas(nlev_cas)) 274 allocate(u_prof_cas(nlev_cas)) 275 allocate(v_prof_cas(nlev_cas)) 276 allocate(vitw_prof_cas(nlev_cas)) 277 allocate(omega_prof_cas(nlev_cas)) 278 allocate(ug_prof_cas(nlev_cas)) 279 allocate(vg_prof_cas(nlev_cas)) 280 allocate(ht_prof_cas(nlev_cas)) 281 allocate(hth_prof_cas(nlev_cas)) 282 allocate(hq_prof_cas(nlev_cas)) 283 allocate(hu_prof_cas(nlev_cas)) 284 allocate(hv_prof_cas(nlev_cas)) 285 allocate(vt_prof_cas(nlev_cas)) 286 allocate(vth_prof_cas(nlev_cas)) 287 allocate(vq_prof_cas(nlev_cas)) 288 allocate(vu_prof_cas(nlev_cas)) 289 allocate(vv_prof_cas(nlev_cas)) 290 allocate(dt_prof_cas(nlev_cas)) 291 allocate(dth_prof_cas(nlev_cas)) 292 allocate(dtrad_prof_cas(nlev_cas)) 293 allocate(dq_prof_cas(nlev_cas)) 294 allocate(du_prof_cas(nlev_cas)) 295 allocate(dv_prof_cas(nlev_cas)) 296 allocate(uw_prof_cas(nlev_cas)) 297 allocate(vw_prof_cas(nlev_cas)) 298 allocate(q1_prof_cas(nlev_cas)) 299 allocate(q2_prof_cas(nlev_cas)) 300 301 print*,'Allocations OK' 302 call read2_cas (nid,nlev_cas,nt_cas, & 303 ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas, & 304 ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas, & 305 dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas, & 306 dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas, & 307 uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, & 308 o3_cas,rugos_cas,clay_cas,sand_cas) 309 print*,'Read2 cas OK' 310 do ii=1,nlev_cas 311 print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1) 312 enddo 313 314 315 END SUBROUTINE read2_1D_cas 316 317 !********************************************************************************************** 318 SUBROUTINE old_read_SCM_cas 319 implicit none 320 320 321 321 #include "netcdf.inc" 322 322 #include "date_cas.h" 323 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 !.......................................................................338 339 340 341 342 343 344 !.......................................................................345 346 347 348 349 350 351 !.......................................................................352 353 354 355 356 357 358 359 360 361 362 !.......................................................................363 364 365 366 367 368 369 370 ! Lecture de l'axe des temps371 372 373 374 375 376 377 324 INTEGER nid,rid,ierr 325 INTEGER ii,jj,timeid 326 REAL, ALLOCATABLE :: time_val(:) 327 328 fich_cas='cas.nc' 329 print*,'fich_cas ',fich_cas 330 ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid) 331 print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid 332 if (ierr.NE.NF_NOERR) then 333 write(*,*) 'ERROR: GROS Pb opening forcings nc file ' 334 write(*,*) NF_STRERROR(ierr) 335 stop "" 336 endif 337 !....................................................................... 338 ierr=NF_INQ_DIMID(nid,'lat',rid) 339 IF (ierr.NE.NF_NOERR) THEN 340 print*, 'Oh probleme lecture dimension lat' 341 ENDIF 342 ierr=NF_INQ_DIMLEN(nid,rid,ii) 343 print*,'OK1 read2: nid,rid,lat',nid,rid,ii 344 !....................................................................... 345 ierr=NF_INQ_DIMID(nid,'lon',rid) 346 IF (ierr.NE.NF_NOERR) THEN 347 print*, 'Oh probleme lecture dimension lon' 348 ENDIF 349 ierr=NF_INQ_DIMLEN(nid,rid,jj) 350 print*,'OK2 read2: nid,rid,lat',nid,rid,jj 351 !....................................................................... 352 ierr=NF_INQ_DIMID(nid,'lev',rid) 353 IF (ierr.NE.NF_NOERR) THEN 354 print*, 'Oh probleme lecture dimension nlev' 355 ENDIF 356 ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas) 357 print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas 358 IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 1000 )) THEN 359 print*,'Valeur de nlev_cas peu probable' 360 STOP 361 ENDIF 362 !....................................................................... 363 ierr=NF_INQ_DIMID(nid,'time',rid) 364 nt_cas=0 365 IF (ierr.NE.NF_NOERR) THEN 366 stop 'Oh probleme lecture dimension time' 367 ENDIF 368 ierr=NF_INQ_DIMLEN(nid,rid,nt_cas) 369 print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas 370 ! Lecture de l'axe des temps 371 print*,'LECTURE DU TEMPS' 372 ierr=NF_INQ_VARID(nid,'time',timeid) 373 if(ierr/=NF_NOERR) then 374 print *,'Variable time manquante dans cas.nc:' 375 ierr=NF_NOERR 376 else 377 allocate(time_val(nt_cas)) 378 378 #ifdef NC_DOUBLE 379 379 ierr = NF_GET_VAR_DOUBLE(nid,timeid,time_val) 380 380 #else 381 381 ierr = NF_GET_VAR_REAL(nid,timeid,time_val) 382 382 #endif 383 384 385 386 endif387 IF (nt_cas>1) THEN388 389 ELSE390 391 ENDIF383 if(ierr/=NF_NOERR) then 384 print *,'Pb a la lecture de time cas.nc: ' 385 endif 386 endif 387 IF (nt_cas>1) THEN 388 pdt_cas=time_val(2)-time_val(1) 389 ELSE 390 pdt_cas=0. 391 ENDIF 392 392 393 393 394 394 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 395 !profils moyens:396 397 398 399 400 401 402 403 404 !forcing405 406 407 408 409 410 411 412 413 414 415 416 417 418 !champs interpoles419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 END SUBROUTINE old_read_SCM_cas395 !profils moyens: 396 allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1)) 397 allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1)) 398 allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1)) 399 allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), & 400 qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas)) 401 allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas)) 402 allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)) 403 404 !forcing 405 allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas)) 406 allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas)) 407 allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas)) 408 allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas)) 409 allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas)) 410 allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas)) 411 allocate(ug_cas(nlev_cas,nt_cas)) 412 allocate(vg_cas(nlev_cas,nt_cas)) 413 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tke_cas(nt_cas)) 414 allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)) 415 416 417 418 !champs interpoles 419 allocate(plev_prof_cas(nlev_cas)) 420 allocate(t_prof_cas(nlev_cas)) 421 allocate(theta_prof_cas(nlev_cas)) 422 allocate(thl_prof_cas(nlev_cas)) 423 allocate(thv_prof_cas(nlev_cas)) 424 allocate(q_prof_cas(nlev_cas)) 425 allocate(qv_prof_cas(nlev_cas)) 426 allocate(ql_prof_cas(nlev_cas)) 427 allocate(qi_prof_cas(nlev_cas)) 428 allocate(rh_prof_cas(nlev_cas)) 429 allocate(rv_prof_cas(nlev_cas)) 430 allocate(u_prof_cas(nlev_cas)) 431 allocate(v_prof_cas(nlev_cas)) 432 allocate(vitw_prof_cas(nlev_cas)) 433 allocate(omega_prof_cas(nlev_cas)) 434 allocate(ug_prof_cas(nlev_cas)) 435 allocate(vg_prof_cas(nlev_cas)) 436 allocate(ht_prof_cas(nlev_cas)) 437 allocate(hth_prof_cas(nlev_cas)) 438 allocate(hq_prof_cas(nlev_cas)) 439 allocate(hu_prof_cas(nlev_cas)) 440 allocate(hv_prof_cas(nlev_cas)) 441 allocate(vt_prof_cas(nlev_cas)) 442 allocate(vth_prof_cas(nlev_cas)) 443 allocate(vq_prof_cas(nlev_cas)) 444 allocate(vu_prof_cas(nlev_cas)) 445 allocate(vv_prof_cas(nlev_cas)) 446 allocate(dt_prof_cas(nlev_cas)) 447 allocate(dth_prof_cas(nlev_cas)) 448 allocate(dtrad_prof_cas(nlev_cas)) 449 allocate(dq_prof_cas(nlev_cas)) 450 allocate(du_prof_cas(nlev_cas)) 451 allocate(dv_prof_cas(nlev_cas)) 452 allocate(uw_prof_cas(nlev_cas)) 453 allocate(vw_prof_cas(nlev_cas)) 454 allocate(q1_prof_cas(nlev_cas)) 455 allocate(q2_prof_cas(nlev_cas)) 456 457 print*,'Allocations OK' 458 call old_read_SCM (nid,nlev_cas,nt_cas, & 459 ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas, & 460 ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,ug_cas,vg_cas,du_cas,hu_cas,vu_cas, & 461 dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas, & 462 dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tke_cas, & 463 uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, & 464 o3_cas,rugos_cas,clay_cas,sand_cas) 465 print*,'Read2 cas OK' 466 do ii=1,nlev_cas 467 print*,'apres read2_cas, plev_cas=',ii,plev_cas(ii,1) 468 enddo 469 470 471 END SUBROUTINE old_read_SCM_cas 472 472 473 473 474 474 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 475 SUBROUTINE deallocate2_1D_cases476 !profils environnementaux:477 478 479 480 481 482 483 484 485 !forcing486 487 488 489 490 491 492 493 494 495 496 !champs interpoles497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 END SUBROUTINE deallocate2_1D_cases475 SUBROUTINE deallocate2_1D_cases 476 !profils environnementaux: 477 deallocate(plev_cas,plevh_cas) 478 479 deallocate(z_cas,zh_cas) 480 deallocate(ap_cas,bp_cas) 481 deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas) 482 deallocate(th_cas,thl_cas,thv_cas,rv_cas) 483 deallocate(u_cas,v_cas,vitw_cas,omega_cas) 484 485 !forcing 486 deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas) 487 deallocate(hq_cas,vq_cas,dq_cas) 488 deallocate(hth_cas,vth_cas,dth_cas) 489 deallocate(hr_cas,vr_cas,dr_cas) 490 deallocate(hu_cas,vu_cas,du_cas) 491 deallocate(hv_cas,vv_cas,dv_cas) 492 deallocate(ug_cas) 493 deallocate(vg_cas) 494 deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tke_cas,uw_cas,vw_cas,q1_cas,q2_cas) 495 496 !champs interpoles 497 deallocate(plev_prof_cas) 498 deallocate(t_prof_cas) 499 deallocate(theta_prof_cas) 500 deallocate(thl_prof_cas) 501 deallocate(thv_prof_cas) 502 deallocate(q_prof_cas) 503 deallocate(qv_prof_cas) 504 deallocate(ql_prof_cas) 505 deallocate(qi_prof_cas) 506 deallocate(rh_prof_cas) 507 deallocate(rv_prof_cas) 508 deallocate(u_prof_cas) 509 deallocate(v_prof_cas) 510 deallocate(vitw_prof_cas) 511 deallocate(omega_prof_cas) 512 deallocate(ug_prof_cas) 513 deallocate(vg_prof_cas) 514 deallocate(ht_prof_cas) 515 deallocate(hq_prof_cas) 516 deallocate(hu_prof_cas) 517 deallocate(hv_prof_cas) 518 deallocate(vt_prof_cas) 519 deallocate(vq_prof_cas) 520 deallocate(vu_prof_cas) 521 deallocate(vv_prof_cas) 522 deallocate(dt_prof_cas) 523 deallocate(dtrad_prof_cas) 524 deallocate(dq_prof_cas) 525 deallocate(du_prof_cas) 526 deallocate(dv_prof_cas) 527 deallocate(t_prof_cas) 528 deallocate(u_prof_cas) 529 deallocate(v_prof_cas) 530 deallocate(uw_prof_cas) 531 deallocate(vw_prof_cas) 532 deallocate(q1_prof_cas) 533 deallocate(q2_prof_cas) 534 535 END SUBROUTINE deallocate2_1D_cases 536 536 537 537 538 538 END MODULE mod_1D_cases_read2 539 539 !===================================================================== 540 541 542 543 544 545 !program reading forcing of the case study546 540 subroutine read_cas2(nid,nlevel,ntime & 541 ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, & 542 du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, & 543 dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2) 544 545 !program reading forcing of the case study 546 implicit none 547 547 #include "netcdf.inc" 548 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&578 'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/579 580 581 582 583 584 585 586 587 588 589 590 591 592 549 integer ntime,nlevel 550 551 real zz(nlevel,ntime) 552 real pp(nlevel,ntime) 553 real temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime) 554 real theta(nlevel,ntime),rv(nlevel,ntime) 555 real u(nlevel,ntime) 556 real v(nlevel,ntime) 557 real ug(nlevel,ntime) 558 real vg(nlevel,ntime) 559 real w(nlevel,ntime) 560 real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 561 real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) 562 real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime) 563 real dtrad(nlevel,ntime) 564 real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime) 565 real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime) 566 real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime) 567 real flat(ntime),sens(ntime),ts(ntime),ustar(ntime) 568 real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime),resul(nlevel,ntime),resul1(ntime) 569 570 571 integer nid, ierr, ierr1,ierr2,rid,i 572 integer nbvar3d 573 parameter(nbvar3d=39) 574 integer var3didin(nbvar3d) 575 character*5 name_var(1:nbvar3d) 576 data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',& 577 'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',& 578 'radT','uw','vw','q1','q2','sens','flat','ts','ustar'/ 579 580 do i=1,nbvar3d 581 print *,'Dans read_cas2, on va lire ',nid,i,name_var(i) 582 enddo 583 do i=1,nbvar3d 584 ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i)) 585 print *,'ierr=',i,ierr,name_var(i),var3didin(i) 586 if(ierr/=NF_NOERR) then 587 print *,'Variable manquante dans cas.nc:',name_var(i) 588 endif 589 enddo 590 do i=1,nbvar3d 591 print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i) 592 if(i.LE.35) then 593 593 #ifdef NC_DOUBLE 594 594 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul) 595 595 #else 596 596 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul) 597 597 #endif 598 599 600 601 602 603 598 print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i) 599 if(ierr/=NF_NOERR) then 600 print *,'Pb a la lecture de cas.nc: ',name_var(i) 601 stop "getvarup" 602 endif 603 else 604 604 #ifdef NC_DOUBLE 605 605 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1) 606 606 #else 607 607 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1) 608 608 #endif 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 609 print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i) 610 if(ierr/=NF_NOERR) then 611 print *,'Pb a la lecture de cas.nc: ',name_var(i) 612 stop "getvarup" 613 endif 614 endif 615 select case(i) 616 case(1) ; zz=resul 617 case(2) ; pp=resul 618 case(3) ; temp=resul 619 case(4) ; qv=resul 620 case(5) ; rh=resul 621 case(6) ; theta=resul 622 case(7) ; rv=resul 623 case(8) ; u=resul 624 case(9) ; v=resul 625 case(10) ; ug=resul 626 case(11) ; vg=resul 627 case(12) ; w=resul 628 case(13) ; du=resul 629 case(14) ; hu=resul 630 case(15) ; vu=resul 631 case(16) ; dv=resul 632 case(17) ; hv=resul 633 case(18) ; vv=resul 634 case(19) ; dt=resul 635 case(20) ; ht=resul 636 case(21) ; vt=resul 637 case(22) ; dq=resul 638 case(23) ; hq=resul 639 case(24) ; vq=resul 640 case(25) ; dth=resul 641 case(26) ; hth=resul 642 case(27) ; vth=resul 643 case(28) ; dr=resul 644 case(29) ; hr=resul 645 case(30) ; vr=resul 646 case(31) ; dtrad=resul 647 case(32) ; uw=resul 648 case(33) ; vw=resul 649 case(34) ; q1=resul 650 case(35) ; q2=resul 651 case(36) ; sens=resul1 652 case(37) ; flat=resul1 653 case(38) ; ts=resul1 654 case(39) ; ustar=resul1 655 end select 656 enddo 657 658 return 659 end subroutine read_cas2 660 660 !====================================================================== 661 662 663 664 665 666 667 668 !program reading forcing of the case study669 661 subroutine read2_cas(nid,nlevel,ntime, & 662 ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,& 663 du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, & 664 dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2, & 665 orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, & 666 heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas) 667 668 !program reading forcing of the case study 669 implicit none 670 670 #include "netcdf.inc" 671 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&703 'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &704 'rh',&705 'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',&706 'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',&707 'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/708 709 710 711 712 !-----------------------------------------------------------------------713 714 715 716 717 718 719 720 !-----------------------------------------------------------------------721 672 integer ntime,nlevel 673 674 real ap(nlevel+1),bp(nlevel+1) 675 real zz(nlevel,ntime),zzh(nlevel+1) 676 real pp(nlevel,ntime),pph(nlevel+1) 677 real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime) 678 real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime) 679 real u(nlevel,ntime),v(nlevel,ntime) 680 real ug(nlevel,ntime),vg(nlevel,ntime) 681 real vitw(nlevel,ntime),omega(nlevel,ntime) 682 real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 683 real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) 684 real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime) 685 real dtrad(nlevel,ntime) 686 real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime) 687 real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime) 688 real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime) 689 real flat(ntime),sens(ntime),ustar(ntime) 690 real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime) 691 real ts(ntime),ps(ntime),tke(ntime) 692 real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas 693 real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3 694 695 696 integer nid, ierr,ierr1,ierr2,rid,i 697 integer nbvar3d 698 parameter(nbvar3d=62) 699 integer var3didin(nbvar3d),missing_var(nbvar3d) 700 character*12 name_var(1:nbvar3d) 701 data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',& 702 'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',& 703 'qadv','qadvh','qadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', & 704 'rh',& 705 'height_f','pressure_f','temp','theta','thv','thl','qv','ql','qi','rv','u','v',& 706 'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar','tke',& 707 'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/ 708 do i=1,nbvar3d 709 missing_var(i)=0. 710 enddo 711 712 !----------------------------------------------------------------------- 713 do i=1,nbvar3d 714 ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i)) 715 if(ierr/=NF_NOERR) then 716 print *,'Variable manquante dans cas.nc:',i,name_var(i) 717 ierr=NF_NOERR 718 missing_var(i)=1 719 else 720 !----------------------------------------------------------------------- 721 if(i.LE.4) then ! Lecture des coord pression en (nlevelp1,lat,lon) 722 722 #ifdef NC_DOUBLE 723 723 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp) … … 730 730 stop "getvarup" 731 731 endif 732 !-----------------------------------------------------------------------733 732 !----------------------------------------------------------------------- 733 else if(i.gt.4.and.i.LE.45) then ! Lecture des variables en (time,nlevel,lat,lon) 734 734 #ifdef NC_DOUBLE 735 735 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul) … … 742 742 stop "getvarup" 743 743 endif 744 !-----------------------------------------------------------------------745 744 !----------------------------------------------------------------------- 745 else if (i.gt.45.and.i.LE.51) then ! Lecture des variables en (time,lat,lon) 746 746 #ifdef NC_DOUBLE 747 747 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2) … … 754 754 stop "getvarup" 755 755 endif 756 !-----------------------------------------------------------------------757 756 !----------------------------------------------------------------------- 757 else ! Lecture des constantes (lat,lon) 758 758 #ifdef NC_DOUBLE 759 759 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3) … … 766 766 stop "getvarup" 767 767 endif 768 769 770 !-----------------------------------------------------------------------771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 !-----------------------------------------------------------------------841 842 843 844 768 endif 769 endif 770 !----------------------------------------------------------------------- 771 select case(i) 772 case(1) ; ap=apbp ! donnees indexees en nlevel+1 773 case(2) ; bp=apbp 774 case(3) ; zzh=apbp 775 case(4) ; pph=apbp 776 case(5) ; vitw=resul ! donnees indexees en nlevel,time 777 case(6) ; omega=resul 778 case(7) ; ug=resul 779 case(8) ; vg=resul 780 case(9) ; du=resul 781 case(10) ; hu=resul 782 case(11) ; vu=resul 783 case(12) ; dv=resul 784 case(13) ; hv=resul 785 case(14) ; vv=resul 786 case(15) ; dt=resul 787 case(16) ; ht=resul 788 case(17) ; vt=resul 789 case(18) ; dq=resul 790 case(19) ; hq=resul 791 case(20) ; vq=resul 792 case(21) ; dth=resul 793 case(22) ; hth=resul 794 case(23) ; vth=resul 795 case(24) ; hthl=resul 796 case(25) ; dr=resul 797 case(26) ; hr=resul 798 case(27) ; vr=resul 799 case(28) ; dtrad=resul 800 case(29) ; q1=resul 801 case(30) ; q2=resul 802 case(31) ; uw=resul 803 case(32) ; vw=resul 804 case(33) ; rh=resul 805 case(34) ; zz=resul ! donnees en time,nlevel pour profil initial 806 case(35) ; pp=resul 807 case(36) ; temp=resul 808 case(37) ; theta=resul 809 case(38) ; thv=resul 810 case(39) ; thl=resul 811 case(40) ; qv=resul 812 case(41) ; ql=resul 813 case(42) ; qi=resul 814 case(43) ; rv=resul 815 case(44) ; u=resul 816 case(45) ; v=resul 817 case(46) ; sens=resul2 ! donnees indexees en time 818 case(47) ; flat=resul2 819 case(48) ; ts=resul2 820 case(49) ; ps=resul2 821 case(50) ; ustar=resul2 822 case(51) ; tke=resul2 823 case(52) ; orog_cas=resul3 ! constantes 824 case(53) ; albedo_cas=resul3 825 case(54) ; emiss_cas=resul3 826 case(55) ; t_skin_cas=resul3 827 case(56) ; q_skin_cas=resul3 828 case(57) ; mom_rough=resul3 829 case(58) ; heat_rough=resul3 830 case(59) ; o3_cas=resul3 831 case(60) ; rugos_cas=resul3 832 case(61) ; clay_cas=resul3 833 case(62) ; sand_cas=resul3 834 end select 835 resul=0. 836 resul1=0. 837 resul2=0. 838 resul3=0. 839 enddo 840 !----------------------------------------------------------------------- 841 842 843 return 844 end subroutine read2_cas 845 845 846 846 !====================================================================== 847 848 849 850 851 852 853 854 !program reading forcing of the case study855 847 subroutine old_read_SCM(nid,nlevel,ntime, & 848 ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,ug,vg,& 849 du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, & 850 dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tke,uw,vw,q1,q2, & 851 orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, & 852 heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas) 853 854 !program reading forcing of the case study 855 implicit none 856 856 #include "netcdf.inc" 857 857 858 859 860 861 862 863 !profils initiaux864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 'temp','qv','ql','qi','u','v','tke','pressure',&892 'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&893 'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', &894 'rh',&895 'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',&896 'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&897 'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/898 899 900 901 902 !-----------------------------------------------------------------------903 904 905 906 907 908 909 910 911 912 !-----------------------------------------------------------------------913 858 integer ntime,nlevel,k,t 859 860 real ap(nlevel+1),bp(nlevel+1) 861 real zz(nlevel,ntime),zzh(nlevel+1) 862 real pp(nlevel,ntime),pph(nlevel+1) 863 !profils initiaux 864 real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel) 865 real pp0(nlevel) 866 real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime) 867 real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime) 868 real u(nlevel,ntime),v(nlevel,ntime),tke(nlevel,ntime) 869 real ug(nlevel,ntime),vg(nlevel,ntime) 870 real vitw(nlevel,ntime),omega(nlevel,ntime) 871 real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 872 real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) 873 real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime) 874 real dtrad(nlevel,ntime) 875 real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime) 876 real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime) 877 real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime) 878 real flat(ntime),sens(ntime),ustar(ntime) 879 real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime) 880 real ts(ntime),ps(ntime) 881 real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas 882 real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3 883 884 885 integer nid, ierr,ierr1,ierr2,rid,i 886 integer nbvar3d 887 parameter(nbvar3d=70) 888 integer var3didin(nbvar3d),missing_var(nbvar3d) 889 character*13 name_var(1:nbvar3d) 890 data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',& 891 'temp','qv','ql','qi','u','v','tke','pressure',& 892 'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',& 893 'qvadv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh','radv','radvh','radvv','radcool','q1','q2','ustress','vstress', & 894 'rh',& 895 'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt','tket',& 896 'sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',& 897 'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough','o3','rugos','clay','sand'/ 898 do i=1,nbvar3d 899 missing_var(i)=0. 900 enddo 901 902 !----------------------------------------------------------------------- 903 904 print*,'ON EST LA' 905 do i=1,nbvar3d 906 ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i)) 907 if(ierr/=NF_NOERR) then 908 print *,'Variable manquante dans cas.nc:',i,name_var(i) 909 ierr=NF_NOERR 910 missing_var(i)=1 911 else 912 !----------------------------------------------------------------------- 913 if(i.LE.4) then ! Lecture des coord pression en (nlevelp1,lat,lon) 914 914 #ifdef NC_DOUBLE 915 915 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp) … … 922 922 stop "getvarup" 923 923 endif 924 !-----------------------------------------------------------------------925 924 !----------------------------------------------------------------------- 925 else if(i.gt.4.and.i.LE.12) then ! Lecture des variables en (time,nlevel,lat,lon) 926 926 #ifdef NC_DOUBLE 927 927 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1) … … 934 934 stop "getvarup" 935 935 endif 936 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)937 !-----------------------------------------------------------------------938 936 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1) 937 !----------------------------------------------------------------------- 938 else if(i.gt.12.and.i.LE.54) then ! Lecture des variables en (time,nlevel,lat,lon) 939 939 #ifdef NC_DOUBLE 940 940 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul) … … 947 947 stop "getvarup" 948 948 endif 949 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)950 !-----------------------------------------------------------------------951 949 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul) 950 !----------------------------------------------------------------------- 951 else if (i.gt.54.and.i.LE.65) then ! Lecture des variables en (time,lat,lon) 952 952 #ifdef NC_DOUBLE 953 953 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2) … … 960 960 stop "getvarup" 961 961 endif 962 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2)963 !-----------------------------------------------------------------------964 962 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2) 963 !----------------------------------------------------------------------- 964 else ! Lecture des constantes (lat,lon) 965 965 #ifdef NC_DOUBLE 966 966 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3) … … 973 973 stop "getvarup" 974 974 endif 975 print*,'Lecture de la variable #i ',i,name_var(i),resul3976 977 978 !-----------------------------------------------------------------------979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 !-----------------------------------------------------------------------1072 1073 1074 975 print*,'Lecture de la variable #i ',i,name_var(i),resul3 976 endif 977 endif 978 !----------------------------------------------------------------------- 979 select case(i) 980 !case(1) ; ap=apbp ! donnees indexees en nlevel+1 981 ! case(2) ; bp=apbp 982 case(3) ; zzh=apbp 983 case(4) ; pph=apbp 984 case(5) ; temp0=resul1 ! donnees initiales 985 case(6) ; qv0=resul1 986 case(7) ; ql0=resul1 987 case(8) ; qi0=resul1 988 case(9) ; u0=resul1 989 case(10) ; v0=resul1 990 case(11) ; tke0=resul1 991 case(12) ; pp0=resul1 992 case(13) ; vitw=resul ! donnees indexees en nlevel,time 993 case(14) ; omega=resul 994 case(15) ; ug=resul 995 case(16) ; vg=resul 996 case(17) ; du=resul 997 case(18) ; hu=resul 998 case(19) ; vu=resul 999 case(20) ; dv=resul 1000 case(21) ; hv=resul 1001 case(22) ; vv=resul 1002 case(23) ; dt=resul 1003 case(24) ; ht=resul 1004 case(25) ; vt=resul 1005 case(26) ; dq=resul 1006 case(27) ; hq=resul 1007 case(28) ; vq=resul 1008 case(29) ; dth=resul 1009 case(30) ; hth=resul 1010 case(31) ; vth=resul 1011 case(32) ; hthl=resul 1012 case(33) ; dr=resul 1013 case(34) ; hr=resul 1014 case(35) ; vr=resul 1015 case(36) ; dtrad=resul 1016 case(37) ; q1=resul 1017 case(38) ; q2=resul 1018 case(39) ; uw=resul 1019 case(40) ; vw=resul 1020 case(41) ; rh=resul 1021 case(42) ; zz=resul ! donnees en time,nlevel pour profil initial 1022 case(43) ; pp=resul 1023 case(44) ; temp=resul 1024 case(45) ; theta=resul 1025 case(46) ; thv=resul 1026 case(47) ; thl=resul 1027 case(48) ; qv=resul 1028 case(49) ; ql=resul 1029 case(50) ; qi=resul 1030 case(51) ; rv=resul 1031 case(52) ; u=resul 1032 case(53) ; v=resul 1033 case(54) ; tke=resul 1034 case(55) ; sens=resul2 ! donnees indexees en time 1035 case(56) ; flat=resul2 1036 case(57) ; ts=resul2 1037 case(58) ; ps=resul2 1038 case(59) ; ustar=resul2 1039 case(60) ; orog_cas=resul3 ! constantes 1040 case(61) ; albedo_cas=resul3 1041 case(62) ; emiss_cas=resul3 1042 case(63) ; t_skin_cas=resul3 1043 case(64) ; q_skin_cas=resul3 1044 case(65) ; mom_rough=resul3 1045 case(66) ; heat_rough=resul3 1046 case(67) ; o3_cas=resul3 1047 case(68) ; rugos_cas=resul3 1048 case(69) ; clay_cas=resul3 1049 case(70) ; sand_cas=resul3 1050 end select 1051 resul=0. 1052 resul1=0. 1053 resul2=0. 1054 resul3=0. 1055 enddo 1056 print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens) 1057 print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat) 1058 1059 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL 1060 do t=1,ntime 1061 do k=1,nlevel 1062 temp(k,t)=temp0(k) 1063 qv(k,t)=qv0(k) 1064 ql(k,t)=ql0(k) 1065 qi(k,t)=qi0(k) 1066 u(k,t)=u0(k) 1067 v(k,t)=v0(k) 1068 tke(k,t)=tke0(k) 1069 enddo 1070 enddo 1071 !----------------------------------------------------------------------- 1072 1073 return 1074 end subroutine old_read_SCM 1075 1075 !====================================================================== 1076 1076 1077 1077 !====================================================================== 1078 1079 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 !---------------------------------------------------------------------------------------1098 ! Time interpolation of a 2D field to the timestep corresponding to day1099 !1100 ! day: current julian day (e.g. 717538.2)1101 ! day1: first day of the simulation1102 ! nt_cas: total nb of data in the forcing1103 ! pdt_cas: total time interval (in sec) between 2 forcing data1104 !---------------------------------------------------------------------------------------1078 SUBROUTINE interp_case_time2(day,day1,annee_ref & 1079 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 1080 ,nt_cas,nlev_cas & 1081 ,ts_cas,ps_cas,plev_cas,t_cas,q_cas,u_cas,v_cas & 1082 ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas & 1083 ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 1084 ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas & 1085 ,uw_cas,vw_cas,q1_cas,q2_cas & 1086 ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas & 1087 ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 1088 ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 1089 ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 1090 ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 1091 ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas & 1092 ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas) 1093 1094 1095 implicit none 1096 1097 !--------------------------------------------------------------------------------------- 1098 ! Time interpolation of a 2D field to the timestep corresponding to day 1099 ! 1100 ! day: current julian day (e.g. 717538.2) 1101 ! day1: first day of the simulation 1102 ! nt_cas: total nb of data in the forcing 1103 ! pdt_cas: total time interval (in sec) between 2 forcing data 1104 !--------------------------------------------------------------------------------------- 1105 1105 1106 1106 #include "compar1d.h" 1107 1107 #include "date_cas.h" 1108 1108 1109 ! inputs:1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 ! outputs:1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 ! local:1143 1144 1145 1146 1147 1148 1149 ! On teste si la date du cas AMMA est correcte.1150 ! C est pour memoire car en fait les fichiers .def1151 ! sont censes etre corrects.1152 ! A supprimer a terme (MPL 20150623)1153 ! if ((forcing_type.eq.10).and.(1.eq.0)) then1154 ! Check that initial day of the simulation consistent with AMMA case:1155 ! if (annee_ref.ne.2006) then1156 ! print*,'Pour AMMA, annee_ref doit etre 2006'1157 ! print*,'Changer annee_ref dans run.def'1158 ! stop1159 ! endif1160 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then1161 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas1162 ! print*,'Changer dayref dans run.def'1163 ! stop1164 ! endif1165 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then1166 ! print*,'AMMA a fini le 11 juillet'1167 ! print*,'Changer dayref ou nday dans run.def'1168 ! stop1169 ! endif1170 ! endif1171 1172 ! Determine timestep relative to the 1st day:1173 ! timeit=(day-day1)*86400.1174 ! if (annee_ref.eq.1992) then1175 ! timeit=(day-day_cas)*86400.1176 ! else1177 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 19921178 ! endif1179 1180 1181 1182 1183 1184 1185 1186 ! Determine the closest observation times:1187 ! it_cas1=INT(timeit/pdt_cas)+11188 ! it_cas2=it_cas1 + 11189 ! time_cas1=(it_cas1-1)*pdt_cas1190 ! time_cas2=(it_cas2-1)*pdt_cas1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 ! time interpolation:1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1109 ! inputs: 1110 integer annee_ref 1111 integer nt_cas,nlev_cas 1112 real day, day1,day_cas 1113 real ts_cas(nt_cas),ps_cas(nt_cas) 1114 real plev_cas(nlev_cas,nt_cas) 1115 real t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas) 1116 real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas) 1117 real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas) 1118 real vitw_cas(nlev_cas,nt_cas) 1119 real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas) 1120 real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas) 1121 real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas) 1122 real dtrad_cas(nlev_cas,nt_cas) 1123 real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas) 1124 real lat_cas(nt_cas) 1125 real sens_cas(nt_cas) 1126 real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas) 1127 real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas) 1128 1129 ! outputs: 1130 real plev_prof_cas(nlev_cas) 1131 real t_prof_cas(nlev_cas),q_prof_cas(nlev_cas) 1132 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 1133 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas) 1134 real vitw_prof_cas(nlev_cas) 1135 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 1136 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 1137 real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas) 1138 real dtrad_prof_cas(nlev_cas) 1139 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 1140 real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas 1141 real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas) 1142 ! local: 1143 integer it_cas1, it_cas2,k 1144 real timeit,time_cas1,time_cas2,frac 1145 1146 1147 print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas 1148 1149 ! On teste si la date du cas AMMA est correcte. 1150 ! C est pour memoire car en fait les fichiers .def 1151 ! sont censes etre corrects. 1152 ! A supprimer a terme (MPL 20150623) 1153 ! if ((forcing_type.eq.10).and.(1.eq.0)) then 1154 ! Check that initial day of the simulation consistent with AMMA case: 1155 ! if (annee_ref.ne.2006) then 1156 ! print*,'Pour AMMA, annee_ref doit etre 2006' 1157 ! print*,'Changer annee_ref dans run.def' 1158 ! stop 1159 ! endif 1160 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then 1161 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas 1162 ! print*,'Changer dayref dans run.def' 1163 ! stop 1164 ! endif 1165 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then 1166 ! print*,'AMMA a fini le 11 juillet' 1167 ! print*,'Changer dayref ou nday dans run.def' 1168 ! stop 1169 ! endif 1170 ! endif 1171 1172 ! Determine timestep relative to the 1st day: 1173 ! timeit=(day-day1)*86400. 1174 ! if (annee_ref.eq.1992) then 1175 ! timeit=(day-day_cas)*86400. 1176 ! else 1177 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 1178 ! endif 1179 timeit=(day-day_ju_ini_cas)*86400 1180 print *,'day=',day 1181 print *,'day_ju_ini_cas=',day_ju_ini_cas 1182 print *,'pdt_cas=',pdt_cas 1183 print *,'timeit=',timeit 1184 print *,'nt_cas=',nt_cas 1185 1186 ! Determine the closest observation times: 1187 ! it_cas1=INT(timeit/pdt_cas)+1 1188 ! it_cas2=it_cas1 + 1 1189 ! time_cas1=(it_cas1-1)*pdt_cas 1190 ! time_cas2=(it_cas2-1)*pdt_cas 1191 1192 it_cas1=INT(timeit/pdt_cas)+1 1193 IF (it_cas1 .EQ. nt_cas) THEN 1194 it_cas2=it_cas1 1195 ELSE 1196 it_cas2=it_cas1 + 1 1197 ENDIF 1198 time_cas1=(it_cas1-1)*pdt_cas 1199 time_cas2=(it_cas2-1)*pdt_cas 1200 print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2 1201 1202 if (it_cas1 .gt. nt_cas) then 1203 write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & 1204 ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit 1205 stop 1206 endif 1207 1208 ! time interpolation: 1209 IF (it_cas1 .EQ. it_cas2) THEN 1210 frac=0. 1211 ELSE 1212 frac=(time_cas2-timeit)/(time_cas2-time_cas1) 1213 frac=max(frac,0.0) 1214 ENDIF 1215 1216 lat_prof_cas = lat_cas(it_cas2) & 1217 -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 1218 sens_prof_cas = sens_cas(it_cas2) & 1219 -frac*(sens_cas(it_cas2)-sens_cas(it_cas1)) 1220 ts_prof_cas = ts_cas(it_cas2) & 1221 -frac*(ts_cas(it_cas2)-ts_cas(it_cas1)) 1222 ustar_prof_cas = ustar_cas(it_cas2) & 1223 -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1)) 1224 1225 do k=1,nlev_cas 1226 plev_prof_cas(k) = plev_cas(k,it_cas2) & 1227 -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1)) 1228 t_prof_cas(k) = t_cas(k,it_cas2) & 1229 -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1)) 1230 q_prof_cas(k) = q_cas(k,it_cas2) & 1231 -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1)) 1232 u_prof_cas(k) = u_cas(k,it_cas2) & 1233 -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1)) 1234 v_prof_cas(k) = v_cas(k,it_cas2) & 1235 -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1)) 1236 ug_prof_cas(k) = ug_cas(k,it_cas2) & 1237 -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1)) 1238 vg_prof_cas(k) = vg_cas(k,it_cas2) & 1239 -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1)) 1240 vitw_prof_cas(k) = vitw_cas(k,it_cas2) & 1241 -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1)) 1242 du_prof_cas(k) = du_cas(k,it_cas2) & 1243 -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1)) 1244 hu_prof_cas(k) = hu_cas(k,it_cas2) & 1245 -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1)) 1246 vu_prof_cas(k) = vu_cas(k,it_cas2) & 1247 -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1)) 1248 dv_prof_cas(k) = dv_cas(k,it_cas2) & 1249 -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1)) 1250 hv_prof_cas(k) = hv_cas(k,it_cas2) & 1251 -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1)) 1252 vv_prof_cas(k) = vv_cas(k,it_cas2) & 1253 -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1)) 1254 dt_prof_cas(k) = dt_cas(k,it_cas2) & 1255 -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1)) 1256 ht_prof_cas(k) = ht_cas(k,it_cas2) & 1257 -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1)) 1258 vt_prof_cas(k) = vt_cas(k,it_cas2) & 1259 -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1)) 1260 dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) & 1261 -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1)) 1262 dq_prof_cas(k) = dq_cas(k,it_cas2) & 1263 -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1)) 1264 hq_prof_cas(k) = hq_cas(k,it_cas2) & 1265 -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1)) 1266 vq_prof_cas(k) = vq_cas(k,it_cas2) & 1267 -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1)) 1268 uw_prof_cas(k) = uw_cas(k,it_cas2) & 1269 -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1)) 1270 vw_prof_cas(k) = vw_cas(k,it_cas2) & 1271 -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1)) 1272 q1_prof_cas(k) = q1_cas(k,it_cas2) & 1273 -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1)) 1274 q2_prof_cas(k) = q2_cas(k,it_cas2) & 1275 -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1)) 1276 enddo 1277 1278 return 1279 END SUBROUTINE interp_case_time2 1280 1280 1281 1281 !********************************************************************************************** 1282 1283 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas &1284 1285 1286 1287 1288 1289 1290 1291 1292 !1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 !---------------------------------------------------------------------------------------1307 ! Time interpolation of a 2D field to the timestep corresponding to day1308 !1309 ! day: current julian day (e.g. 717538.2)1310 ! day1: first day of the simulation1311 ! nt_cas: total nb of data in the forcing1312 ! pdt_cas: total time interval (in sec) between 2 forcing data1313 !---------------------------------------------------------------------------------------1282 SUBROUTINE interp2_case_time(day,day1,annee_ref & 1283 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 1284 ,nt_cas,nlev_cas & 1285 ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas & 1286 ,qv_cas,ql_cas,qi_cas,u_cas,v_cas & 1287 ,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas & 1288 ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 1289 ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas & 1290 ,lat_cas,sens_cas,ustar_cas & 1291 ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas & 1292 ! 1293 ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas & 1294 ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & 1295 ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 1296 ,vitw_prof_cas,omega_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 1297 ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 1298 ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 1299 ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas & 1300 ,lat_prof_cas,sens_prof_cas & 1301 ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas) 1302 1303 1304 implicit none 1305 1306 !--------------------------------------------------------------------------------------- 1307 ! Time interpolation of a 2D field to the timestep corresponding to day 1308 ! 1309 ! day: current julian day (e.g. 717538.2) 1310 ! day1: first day of the simulation 1311 ! nt_cas: total nb of data in the forcing 1312 ! pdt_cas: total time interval (in sec) between 2 forcing data 1313 !--------------------------------------------------------------------------------------- 1314 1314 1315 1315 #include "compar1d.h" 1316 1316 #include "date_cas.h" 1317 1317 1318 ! inputs:1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 ! outputs:1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 ! local:1355 1356 1357 1358 1359 1360 ! do k=1,nlev_cas1361 ! print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)1362 ! enddo1363 1364 ! On teste si la date du cas AMMA est correcte.1365 ! C est pour memoire car en fait les fichiers .def1366 ! sont censes etre corrects.1367 ! A supprimer a terme (MPL 20150623)1368 ! if ((forcing_type.eq.10).and.(1.eq.0)) then1369 ! Check that initial day of the simulation consistent with AMMA case:1370 ! if (annee_ref.ne.2006) then1371 ! print*,'Pour AMMA, annee_ref doit etre 2006'1372 ! print*,'Changer annee_ref dans run.def'1373 ! stop1374 ! endif1375 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then1376 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas1377 ! print*,'Changer dayref dans run.def'1378 ! stop1379 ! endif1380 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then1381 ! print*,'AMMA a fini le 11 juillet'1382 ! print*,'Changer dayref ou nday dans run.def'1383 ! stop1384 ! endif1385 ! endif1386 1387 ! Determine timestep relative to the 1st day:1388 ! timeit=(day-day1)*86400.1389 ! if (annee_ref.eq.1992) then1390 ! timeit=(day-day_cas)*86400.1391 ! else1392 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 19921393 ! endif1394 1395 1396 1397 1398 1399 1400 1401 ! Determine the closest observation times:1402 ! it_cas1=INT(timeit/pdt_cas)+11403 ! it_cas2=it_cas1 + 11404 ! time_cas1=(it_cas1-1)*pdt_cas1405 ! time_cas2=(it_cas2-1)*pdt_cas1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 ! time interpolation:1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1318 ! inputs: 1319 integer annee_ref 1320 integer nt_cas,nlev_cas 1321 real day, day1,day_cas 1322 real ts_cas(nt_cas),ps_cas(nt_cas) 1323 real plev_cas(nlev_cas,nt_cas) 1324 real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas) 1325 real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas) 1326 real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas) 1327 real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas) 1328 real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas) 1329 real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas) 1330 real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas) 1331 real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas) 1332 real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas) 1333 real dtrad_cas(nlev_cas,nt_cas) 1334 real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas) 1335 real lat_cas(nt_cas),sens_cas(nt_cas),tke_cas(nt_cas) 1336 real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas) 1337 real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas) 1338 1339 ! outputs: 1340 real plev_prof_cas(nlev_cas) 1341 real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas) 1342 real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas) 1343 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 1344 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas) 1345 real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas) 1346 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 1347 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 1348 real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas) 1349 real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas) 1350 real dtrad_prof_cas(nlev_cas) 1351 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 1352 real lat_prof_cas,sens_prof_cas,tke_prof_cas,ts_prof_cas,ustar_prof_cas 1353 real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas) 1354 ! local: 1355 integer it_cas1, it_cas2,k 1356 real timeit,time_cas1,time_cas2,frac 1357 1358 1359 print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas 1360 ! do k=1,nlev_cas 1361 ! print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1) 1362 ! enddo 1363 1364 ! On teste si la date du cas AMMA est correcte. 1365 ! C est pour memoire car en fait les fichiers .def 1366 ! sont censes etre corrects. 1367 ! A supprimer a terme (MPL 20150623) 1368 ! if ((forcing_type.eq.10).and.(1.eq.0)) then 1369 ! Check that initial day of the simulation consistent with AMMA case: 1370 ! if (annee_ref.ne.2006) then 1371 ! print*,'Pour AMMA, annee_ref doit etre 2006' 1372 ! print*,'Changer annee_ref dans run.def' 1373 ! stop 1374 ! endif 1375 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then 1376 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas 1377 ! print*,'Changer dayref dans run.def' 1378 ! stop 1379 ! endif 1380 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then 1381 ! print*,'AMMA a fini le 11 juillet' 1382 ! print*,'Changer dayref ou nday dans run.def' 1383 ! stop 1384 ! endif 1385 ! endif 1386 1387 ! Determine timestep relative to the 1st day: 1388 ! timeit=(day-day1)*86400. 1389 ! if (annee_ref.eq.1992) then 1390 ! timeit=(day-day_cas)*86400. 1391 ! else 1392 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 1393 ! endif 1394 timeit=(day-day_ju_ini_cas)*86400 1395 print *,'day=',day 1396 print *,'day_ju_ini_cas=',day_ju_ini_cas 1397 print *,'pdt_cas=',pdt_cas 1398 print *,'timeit=',timeit 1399 print *,'nt_cas=',nt_cas 1400 1401 ! Determine the closest observation times: 1402 ! it_cas1=INT(timeit/pdt_cas)+1 1403 ! it_cas2=it_cas1 + 1 1404 ! time_cas1=(it_cas1-1)*pdt_cas 1405 ! time_cas2=(it_cas2-1)*pdt_cas 1406 1407 it_cas1=INT(timeit/pdt_cas)+1 1408 IF (it_cas1 .EQ. nt_cas) THEN 1409 it_cas2=it_cas1 1410 ELSE 1411 it_cas2=it_cas1 + 1 1412 ENDIF 1413 time_cas1=(it_cas1-1)*pdt_cas 1414 time_cas2=(it_cas2-1)*pdt_cas 1415 print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas 1416 print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2 1417 1418 if (it_cas1 .gt. nt_cas) then 1419 write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & 1420 ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit 1421 stop 1422 endif 1423 1424 ! time interpolation: 1425 IF (it_cas1 .EQ. it_cas2) THEN 1426 frac=0. 1427 ELSE 1428 frac=(time_cas2-timeit)/(time_cas2-time_cas1) 1429 frac=max(frac,0.0) 1430 ENDIF 1431 1432 lat_prof_cas = lat_cas(it_cas2) & 1433 -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 1434 sens_prof_cas = sens_cas(it_cas2) & 1435 -frac*(sens_cas(it_cas2)-sens_cas(it_cas1)) 1436 tke_prof_cas = tke_cas(it_cas2) & 1437 -frac*(tke_cas(it_cas2)-tke_cas(it_cas1)) 1438 ts_prof_cas = ts_cas(it_cas2) & 1439 -frac*(ts_cas(it_cas2)-ts_cas(it_cas1)) 1440 ustar_prof_cas = ustar_cas(it_cas2) & 1441 -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1)) 1442 1443 do k=1,nlev_cas 1444 plev_prof_cas(k) = plev_cas(k,it_cas2) & 1445 -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1)) 1446 t_prof_cas(k) = t_cas(k,it_cas2) & 1447 -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1)) 1448 print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2) 1449 theta_prof_cas(k) = theta_cas(k,it_cas2) & 1450 -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1)) 1451 thv_prof_cas(k) = thv_cas(k,it_cas2) & 1452 -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1)) 1453 thl_prof_cas(k) = thl_cas(k,it_cas2) & 1454 -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1)) 1455 qv_prof_cas(k) = qv_cas(k,it_cas2) & 1456 -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1)) 1457 ql_prof_cas(k) = ql_cas(k,it_cas2) & 1458 -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1)) 1459 qi_prof_cas(k) = qi_cas(k,it_cas2) & 1460 -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1)) 1461 u_prof_cas(k) = u_cas(k,it_cas2) & 1462 -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1)) 1463 v_prof_cas(k) = v_cas(k,it_cas2) & 1464 -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1)) 1465 ug_prof_cas(k) = ug_cas(k,it_cas2) & 1466 -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1)) 1467 vg_prof_cas(k) = vg_cas(k,it_cas2) & 1468 -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1)) 1469 vitw_prof_cas(k) = vitw_cas(k,it_cas2) & 1470 -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1)) 1471 omega_prof_cas(k) = omega_cas(k,it_cas2) & 1472 -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1)) 1473 du_prof_cas(k) = du_cas(k,it_cas2) & 1474 -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1)) 1475 hu_prof_cas(k) = hu_cas(k,it_cas2) & 1476 -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1)) 1477 vu_prof_cas(k) = vu_cas(k,it_cas2) & 1478 -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1)) 1479 dv_prof_cas(k) = dv_cas(k,it_cas2) & 1480 -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1)) 1481 hv_prof_cas(k) = hv_cas(k,it_cas2) & 1482 -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1)) 1483 vv_prof_cas(k) = vv_cas(k,it_cas2) & 1484 -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1)) 1485 dt_prof_cas(k) = dt_cas(k,it_cas2) & 1486 -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1)) 1487 ht_prof_cas(k) = ht_cas(k,it_cas2) & 1488 -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1)) 1489 vt_prof_cas(k) = vt_cas(k,it_cas2) & 1490 -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1)) 1491 dth_prof_cas(k) = dth_cas(k,it_cas2) & 1492 -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1)) 1493 hth_prof_cas(k) = hth_cas(k,it_cas2) & 1494 -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1)) 1495 vth_prof_cas(k) = vth_cas(k,it_cas2) & 1496 -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1)) 1497 dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) & 1498 -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1)) 1499 dq_prof_cas(k) = dq_cas(k,it_cas2) & 1500 -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1)) 1501 hq_prof_cas(k) = hq_cas(k,it_cas2) & 1502 -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1)) 1503 vq_prof_cas(k) = vq_cas(k,it_cas2) & 1504 -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1)) 1505 uw_prof_cas(k) = uw_cas(k,it_cas2) & 1506 -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1)) 1507 vw_prof_cas(k) = vw_cas(k,it_cas2) & 1508 -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1)) 1509 q1_prof_cas(k) = q1_cas(k,it_cas2) & 1510 -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1)) 1511 q2_prof_cas(k) = q2_cas(k,it_cas2) & 1512 -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1)) 1513 enddo 1514 1515 return 1516 END SUBROUTINE interp2_case_time 1517 1517 1518 1518 !********************************************************************************************** -
LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90
r4271 r4272 5 5 6 6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 7 !Declarations specifiques au cas standard8 9 ! Discr?tisation10 11 12 13 !profils environnementaux14 15 16 17 18 19 20 21 22 !forcing23 24 25 26 27 28 29 30 31 32 33 34 35 !champs interpoles36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 7 !Declarations specifiques au cas standard 8 character*80 :: fich_cas 9 ! Discr?tisation 10 integer nlev_cas, nt_cas 11 12 13 !profils environnementaux 14 real, allocatable:: plev_cas(:,:),plevh_cas(:) 15 real, allocatable:: ap_cas(:),bp_cas(:) 16 17 real, allocatable:: z_cas(:,:),zh_cas(:) 18 real, allocatable:: t_cas(:,:),q_cas(:,:),qv_cas(:,:),ql_cas(:,:),qi_cas(:,:),rh_cas(:,:) 19 real, allocatable:: th_cas(:,:),thv_cas(:,:),thl_cas(:,:),rv_cas(:,:) 20 real, allocatable:: u_cas(:,:),v_cas(:,:),vitw_cas(:,:),omega_cas(:,:),tke_cas(:,:) 21 22 !forcing 23 real, allocatable:: ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:) 24 real, allocatable:: hth_cas(:,:),vth_cas(:,:),dth_cas(:,:) 25 real, allocatable:: hq_cas(:,:),vq_cas(:,:),dq_cas(:,:) 26 real, allocatable:: hr_cas(:,:),vr_cas(:,:),dr_cas(:,:) 27 real, allocatable:: hu_cas(:,:),vu_cas(:,:),du_cas(:,:) 28 real, allocatable:: hv_cas(:,:),vv_cas(:,:),dv_cas(:,:) 29 real, allocatable:: ug_cas(:,:),vg_cas(:,:) 30 real, allocatable:: temp_nudg_cas(:,:),qv_nudg_cas(:,:),u_nudg_cas(:,:),v_nudg_cas(:,:) 31 real, allocatable:: invtau_temp_nudg_cas(:,:),invtau_qv_nudg_cas(:,:),invtau_u_nudg_cas(:,:),invtau_v_nudg_cas(:,:) 32 real, allocatable:: lat_cas(:),sens_cas(:),ts_cas(:),ps_cas(:),ustar_cas(:) 33 real, allocatable:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:),tkes_cas(:) 34 35 !champs interpoles 36 real, allocatable:: plev_prof_cas(:) 37 real, allocatable:: t_prof_cas(:) 38 real, allocatable:: theta_prof_cas(:) 39 real, allocatable:: thl_prof_cas(:) 40 real, allocatable:: thv_prof_cas(:) 41 real, allocatable:: q_prof_cas(:) 42 real, allocatable:: qv_prof_cas(:) 43 real, allocatable:: ql_prof_cas(:) 44 real, allocatable:: qi_prof_cas(:) 45 real, allocatable:: rh_prof_cas(:) 46 real, allocatable:: rv_prof_cas(:) 47 real, allocatable:: u_prof_cas(:) 48 real, allocatable:: v_prof_cas(:) 49 real, allocatable:: vitw_prof_cas(:) 50 real, allocatable:: omega_prof_cas(:) 51 real, allocatable:: tke_prof_cas(:) 52 real, allocatable:: ug_prof_cas(:) 53 real, allocatable:: vg_prof_cas(:) 54 real, allocatable:: temp_nudg_prof_cas(:),qv_nudg_prof_cas(:),u_nudg_prof_cas(:),v_nudg_prof_cas(:) 55 real, allocatable:: invtau_temp_nudg_prof_cas(:),invtau_qv_nudg_prof_cas(:),invtau_u_nudg_prof_cas(:),invtau_v_nudg_prof_cas(:) 56 57 real, allocatable:: ht_prof_cas(:) 58 real, allocatable:: hth_prof_cas(:) 59 real, allocatable:: hq_prof_cas(:) 60 real, allocatable:: vt_prof_cas(:) 61 real, allocatable:: vth_prof_cas(:) 62 real, allocatable:: vq_prof_cas(:) 63 real, allocatable:: dt_prof_cas(:) 64 real, allocatable:: dth_prof_cas(:) 65 real, allocatable:: dtrad_prof_cas(:) 66 real, allocatable:: dq_prof_cas(:) 67 real, allocatable:: hu_prof_cas(:) 68 real, allocatable:: hv_prof_cas(:) 69 real, allocatable:: vu_prof_cas(:) 70 real, allocatable:: vv_prof_cas(:) 71 real, allocatable:: du_prof_cas(:) 72 real, allocatable:: dv_prof_cas(:) 73 real, allocatable:: uw_prof_cas(:) 74 real, allocatable:: vw_prof_cas(:) 75 real, allocatable:: q1_prof_cas(:) 76 real, allocatable:: q2_prof_cas(:) 77 78 79 real o3_cas,lat_prof_cas,sens_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas,tkes_prof_cas 80 real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,rugos_cas,sand_cas,clay_cas 81 82 82 83 83 … … 85 85 86 86 87 !**********************************************************************************************88 SUBROUTINE read_SCM_cas89 87 !********************************************************************************************** 88 SUBROUTINE read_SCM_cas 89 implicit none 90 90 91 91 #include "netcdf.inc" 92 92 #include "date_cas.h" 93 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 !.......................................................................108 109 110 111 112 113 114 !.......................................................................115 116 117 118 119 120 121 !.......................................................................122 123 124 125 126 127 128 129 130 131 132 !.......................................................................133 134 135 136 137 138 139 140 ! Lecture de l'axe des temps141 142 143 144 145 146 147 94 INTEGER nid,rid,ierr 95 INTEGER ii,jj,timeid 96 REAL, ALLOCATABLE :: time_val(:) 97 98 fich_cas='cas.nc' 99 print*,'fich_cas ',fich_cas 100 ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid) 101 print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid 102 if (ierr.NE.NF_NOERR) then 103 write(*,*) 'ERROR: GROS Pb opening forcings nc file ' 104 write(*,*) NF_STRERROR(ierr) 105 stop "" 106 endif 107 !....................................................................... 108 ierr=NF_INQ_DIMID(nid,'lat',rid) 109 IF (ierr.NE.NF_NOERR) THEN 110 print*, 'Oh probleme lecture dimension lat' 111 ENDIF 112 ierr=NF_INQ_DIMLEN(nid,rid,ii) 113 print*,'OK1 read2: nid,rid,lat',nid,rid,ii 114 !....................................................................... 115 ierr=NF_INQ_DIMID(nid,'lon',rid) 116 IF (ierr.NE.NF_NOERR) THEN 117 print*, 'Oh probleme lecture dimension lon' 118 ENDIF 119 ierr=NF_INQ_DIMLEN(nid,rid,jj) 120 print*,'OK2 read2: nid,rid,lat',nid,rid,jj 121 !....................................................................... 122 ierr=NF_INQ_DIMID(nid,'lev',rid) 123 IF (ierr.NE.NF_NOERR) THEN 124 print*, 'Oh probleme lecture dimension nlev' 125 ENDIF 126 ierr=NF_INQ_DIMLEN(nid,rid,nlev_cas) 127 print*,'OK3 read2: nid,rid,nlev_cas',nid,rid,nlev_cas 128 IF ( .NOT. ( nlev_cas > 10 .AND. nlev_cas < 200000 )) THEN 129 print*,'Valeur de nlev_cas peu probable' 130 STOP 131 ENDIF 132 !....................................................................... 133 ierr=NF_INQ_DIMID(nid,'time',rid) 134 nt_cas=0 135 IF (ierr.NE.NF_NOERR) THEN 136 stop 'Oh probleme lecture dimension time' 137 ENDIF 138 ierr=NF_INQ_DIMLEN(nid,rid,nt_cas) 139 print*,'OK4 read2: nid,rid,nt_cas',nid,rid,nt_cas 140 ! Lecture de l'axe des temps 141 print*,'LECTURE DU TEMPS' 142 ierr=NF_INQ_VARID(nid,'time',timeid) 143 if(ierr/=NF_NOERR) then 144 print *,'Variable time manquante dans cas.nc:' 145 ierr=NF_NOERR 146 else 147 allocate(time_val(nt_cas)) 148 148 #ifdef NC_DOUBLE 149 149 ierr = NF_GET_VAR_DOUBLE(nid,timeid,time_val) 150 150 #else 151 151 ierr = NF_GET_VAR_REAL(nid,timeid,time_val) 152 152 #endif 153 154 155 156 endif157 IF (nt_cas>1) THEN158 159 ELSE160 161 ENDIF153 if(ierr/=NF_NOERR) then 154 print *,'Pb a la lecture de time cas.nc: ' 155 endif 156 endif 157 IF (nt_cas>1) THEN 158 pdt_cas=time_val(2)-time_val(1) 159 ELSE 160 pdt_cas=0. 161 ENDIF 162 162 163 163 164 164 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 165 !profils moyens:166 167 168 169 170 171 172 173 174 !forcing175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 !champs interpoles192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 END SUBROUTINE read_SCM_cas165 !profils moyens: 166 allocate(plev_cas(nlev_cas,nt_cas),plevh_cas(nlev_cas+1)) 167 allocate(z_cas(nlev_cas,nt_cas),zh_cas(nlev_cas+1)) 168 allocate(ap_cas(nlev_cas+1),bp_cas(nt_cas+1)) 169 allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas), & 170 qi_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas)) 171 allocate(th_cas(nlev_cas,nt_cas),thl_cas(nlev_cas,nt_cas),thv_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas)) 172 allocate(u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas),vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas)) 173 allocate(tke_cas(nlev_cas,nt_cas)) 174 !forcing 175 allocate(ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas),dt_cas(nlev_cas,nt_cas),dtrad_cas(nlev_cas,nt_cas)) 176 allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas)) 177 allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas)) 178 allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas)) 179 allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas)) 180 allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas)) 181 allocate(ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas)) 182 allocate(temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas)) 183 allocate(u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas)) 184 allocate(invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas)) 185 allocate(invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas)) 186 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ps_cas(nt_cas),ustar_cas(nt_cas),tkes_cas(nt_cas)) 187 allocate(uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas),q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas)) 188 189 190 191 !champs interpoles 192 allocate(plev_prof_cas(nlev_cas)) 193 allocate(t_prof_cas(nlev_cas)) 194 allocate(theta_prof_cas(nlev_cas)) 195 allocate(thl_prof_cas(nlev_cas)) 196 allocate(thv_prof_cas(nlev_cas)) 197 allocate(q_prof_cas(nlev_cas)) 198 allocate(qv_prof_cas(nlev_cas)) 199 allocate(ql_prof_cas(nlev_cas)) 200 allocate(qi_prof_cas(nlev_cas)) 201 allocate(rh_prof_cas(nlev_cas)) 202 allocate(rv_prof_cas(nlev_cas)) 203 allocate(u_prof_cas(nlev_cas)) 204 allocate(v_prof_cas(nlev_cas)) 205 allocate(vitw_prof_cas(nlev_cas)) 206 allocate(omega_prof_cas(nlev_cas)) 207 allocate(tke_prof_cas(nlev_cas)) 208 allocate(ug_prof_cas(nlev_cas)) 209 allocate(vg_prof_cas(nlev_cas)) 210 allocate(temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas)) 211 allocate(u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas)) 212 allocate(invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas)) 213 allocate(invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas)) 214 allocate(ht_prof_cas(nlev_cas)) 215 allocate(hth_prof_cas(nlev_cas)) 216 allocate(hq_prof_cas(nlev_cas)) 217 allocate(hu_prof_cas(nlev_cas)) 218 allocate(hv_prof_cas(nlev_cas)) 219 allocate(vt_prof_cas(nlev_cas)) 220 allocate(vth_prof_cas(nlev_cas)) 221 allocate(vq_prof_cas(nlev_cas)) 222 allocate(vu_prof_cas(nlev_cas)) 223 allocate(vv_prof_cas(nlev_cas)) 224 allocate(dt_prof_cas(nlev_cas)) 225 allocate(dth_prof_cas(nlev_cas)) 226 allocate(dtrad_prof_cas(nlev_cas)) 227 allocate(dq_prof_cas(nlev_cas)) 228 allocate(du_prof_cas(nlev_cas)) 229 allocate(dv_prof_cas(nlev_cas)) 230 allocate(uw_prof_cas(nlev_cas)) 231 allocate(vw_prof_cas(nlev_cas)) 232 allocate(q1_prof_cas(nlev_cas)) 233 allocate(q2_prof_cas(nlev_cas)) 234 235 print*,'Allocations OK' 236 CALL read_SCM (nid,nlev_cas,nt_cas, & 237 ap_cas,bp_cas,z_cas,plev_cas,zh_cas,plevh_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas, & 238 ql_cas,qi_cas,rh_cas,rv_cas,u_cas,v_cas,vitw_cas,omega_cas,tke_cas,ug_cas,vg_cas, & 239 temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas, & 240 invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas, & 241 du_cas,hu_cas,vu_cas, & 242 dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas, & 243 dr_cas,hr_cas,vr_cas,dtrad_cas,sens_cas,lat_cas,ts_cas,ps_cas,ustar_cas,tkes_cas, & 244 uw_cas,vw_cas,q1_cas,q2_cas,orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough, & 245 o3_cas,rugos_cas,clay_cas,sand_cas) 246 print*,'read_SCM cas OK' 247 do ii=1,nlev_cas 248 print*,'apres read2_SCM, plev_cas=',ii,plev_cas(ii,1) 249 !print*,'apres read_SCM, plev_cas=',ii,omega_cas(ii,nt_cas/2+1) 250 enddo 251 252 253 END SUBROUTINE read_SCM_cas 254 254 255 255 256 256 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 257 SUBROUTINE deallocate2_1D_cases258 !profils environnementaux:259 260 261 262 263 264 265 266 267 !forcing268 269 270 271 272 273 274 275 276 277 278 !champs interpoles279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 END SUBROUTINE deallocate2_1D_cases321 322 323 !=====================================================================324 325 326 327 328 329 330 331 332 333 !program reading forcing of the case study334 257 SUBROUTINE deallocate2_1D_cases 258 !profils environnementaux: 259 deallocate(plev_cas,plevh_cas) 260 261 deallocate(z_cas,zh_cas) 262 deallocate(ap_cas,bp_cas) 263 deallocate(t_cas,q_cas,qv_cas,ql_cas,qi_cas,rh_cas) 264 deallocate(th_cas,thl_cas,thv_cas,rv_cas) 265 deallocate(u_cas,v_cas,vitw_cas,omega_cas,tke_cas) 266 267 !forcing 268 deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas) 269 deallocate(hq_cas,vq_cas,dq_cas) 270 deallocate(hth_cas,vth_cas,dth_cas) 271 deallocate(hr_cas,vr_cas,dr_cas) 272 deallocate(hu_cas,vu_cas,du_cas) 273 deallocate(hv_cas,vv_cas,dv_cas) 274 deallocate(ug_cas) 275 deallocate(vg_cas) 276 deallocate(lat_cas,sens_cas,ts_cas,ps_cas,ustar_cas,tkes_cas,uw_cas,vw_cas,q1_cas,q2_cas) 277 278 !champs interpoles 279 deallocate(plev_prof_cas) 280 deallocate(t_prof_cas) 281 deallocate(theta_prof_cas) 282 deallocate(thl_prof_cas) 283 deallocate(thv_prof_cas) 284 deallocate(q_prof_cas) 285 deallocate(qv_prof_cas) 286 deallocate(ql_prof_cas) 287 deallocate(qi_prof_cas) 288 deallocate(rh_prof_cas) 289 deallocate(rv_prof_cas) 290 deallocate(u_prof_cas) 291 deallocate(v_prof_cas) 292 deallocate(vitw_prof_cas) 293 deallocate(omega_prof_cas) 294 deallocate(tke_prof_cas) 295 deallocate(ug_prof_cas) 296 deallocate(vg_prof_cas) 297 deallocate(temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas) 298 deallocate(invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas) 299 deallocate(ht_prof_cas) 300 deallocate(hq_prof_cas) 301 deallocate(hu_prof_cas) 302 deallocate(hv_prof_cas) 303 deallocate(vt_prof_cas) 304 deallocate(vq_prof_cas) 305 deallocate(vu_prof_cas) 306 deallocate(vv_prof_cas) 307 deallocate(dt_prof_cas) 308 deallocate(dtrad_prof_cas) 309 deallocate(dq_prof_cas) 310 deallocate(du_prof_cas) 311 deallocate(dv_prof_cas) 312 deallocate(t_prof_cas) 313 deallocate(u_prof_cas) 314 deallocate(v_prof_cas) 315 deallocate(uw_prof_cas) 316 deallocate(vw_prof_cas) 317 deallocate(q1_prof_cas) 318 deallocate(q2_prof_cas) 319 320 END SUBROUTINE deallocate2_1D_cases 321 322 323 !===================================================================== 324 SUBROUTINE read_SCM(nid,nlevel,ntime, & 325 ap,bp,zz,pp,zzh,pph,temp,theta,thv,thl,qv,ql,qi,rh,rv,u,v,vitw,omega,tke,ug,vg,& 326 temp_nudg,qv_nudg,u_nudg,v_nudg, & 327 invtau_temp_nudg,invtau_qv_nudg,invtau_u_nudg,invtau_v_nudg, & 328 du,hu,vu,dv,hv,vv,dt,ht,vt,dq,hq,vq, & 329 dth,hth,vth,dr,hr,vr,dtrad,sens,flat,ts,ps,ustar,tkes,uw,vw,q1,q2, & 330 orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough, & 331 heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas) 332 333 !program reading forcing of the case study 334 implicit none 335 335 #include "netcdf.inc" 336 336 #include "compar1d.h" 337 337 338 339 340 341 342 343 !profils initiaux344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 ! data name_var/ &375 ! ! coordonnees pression (n+1 niveaux) #4376 ! & 'coor_par_a','coor_par_b','height_h','pressure_h',& ! #1-#4377 ! ! coordonnees pression (n niveaux) #8378 ! &'temp','qv','ql','qi','u','v','tke','pressure',& ! #5-#12379 ! ! coordonnees pression + temps #42380 ! &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','temp_adv','tadvh','tadvv',& ! #13 - #25381 ! &'qv_adv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh', & ! #26 - #32382 ! & 'radv','radvh','radvv','radcool','q1','q2','ustress','vstress', & ! #33 - #40383 ! & 'rh','temp_nudging','qv_nudging','u_nudging','v_nudging', & ! #41-45384 ! &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt', & ! #46-58385 ! ! coordonnees temps #12386 ! &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',&387 ! &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',&388 ! ! scalaires #4389 ! &'o3','rugos','clay','sand'/390 391 392 393 394 ! coordonnees pression (n+1 niveaux) #4395 'coor_par_a','coor_par_b','zf','pressure_h',& ! #1-#4396 ! coordonnees pression (n niveaux) #8397 'ta','qv','ql','qi','ua','va','tke','pa',& ! #5-#12398 ! coordonnees pression + temps #46399 'wa','wap','ug','vg','tnua_adv','tnua_advh','tnua_advv','tnva_adv','tnva_advh','tnva_advv','tnta_adv','tnta_advh','tnta_advv',& ! #13 - #25400 'tnqv_adv','tnqv_advh','tnqv_advv','thadv','thadvh','thadvv','thladvh', & ! #26 - #32401 'radv','radvh','radvv','tnta_rad','q1','q2','ustress','vstress', & ! #33 - #40402 'rh','ta_nud','qv_nud','ua_nud','va_nud', & ! #41-45403 'zh_forc','pa_forc','tat','thetat','thetavt','thetalt','qvt','qlt','qit','rv','uat','vat', & ! #46-57404 'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va', & ! # 58-61405 ! coordonnees temps #12406 'tkes','hfss','hfls','ts_forc','ps_forc','ustar', & ! 62-67407 'orog','albedo','emiss','t_skin','q_skin','z0','z0h', & ! 68-74408 ! scalaires #4409 'O3','rugos','clay','sand'/ ! 75-78410 411 412 !-----------------------------------------------------------------------413 ! First check that we are using a version > v2 of the 1D standard format414 ! use the difference between 'temp' (old version) and 'ta' (new version)415 !-----------------------------------------------------------------------416 417 418 419 420 421 422 423 424 425 426 427 428 !-----------------------------------------------------------------------429 ! Checking availability of variable #i in the cas.nc file430 ! missing_var=1 if the variable is missing431 !-----------------------------------------------------------------------432 433 434 435 436 437 438 439 440 441 442 443 !-----------------------------------------------------------------------444 ! Activating keys depending on the presence of specific variables in cas.nc445 !-----------------------------------------------------------------------446 if ( 1 == 1 ) THEN447 ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc...448 ! if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp'449 if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv'450 if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u'451 if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v'452 ELSE338 integer ntime,nlevel,k,t 339 340 real ap(nlevel+1),bp(nlevel+1) 341 real zz(nlevel,ntime),zzh(nlevel+1) 342 real pp(nlevel,ntime),pph(nlevel+1) 343 !profils initiaux 344 real temp0(nlevel),qv0(nlevel),ql0(nlevel),qi0(nlevel),u0(nlevel),v0(nlevel),tke0(nlevel) 345 real pp0(nlevel) 346 real temp(nlevel,ntime),qv(nlevel,ntime),ql(nlevel,ntime),qi(nlevel,ntime),rh(nlevel,ntime) 347 real theta(nlevel,ntime),thv(nlevel,ntime),thl(nlevel,ntime),rv(nlevel,ntime) 348 real u(nlevel,ntime),v(nlevel,ntime),tkes(ntime) 349 real temp_nudg(nlevel,ntime),qv_nudg(nlevel,ntime),u_nudg(nlevel,ntime),v_nudg(nlevel,ntime) 350 real invtau_temp_nudg(nlevel,ntime),invtau_qv_nudg(nlevel,ntime),invtau_u_nudg(nlevel,ntime),invtau_v_nudg(nlevel,ntime) 351 real ug(nlevel,ntime),vg(nlevel,ntime) 352 real vitw(nlevel,ntime),omega(nlevel,ntime),tke(nlevel,ntime) 353 real du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 354 real dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) 355 real dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime) 356 real dtrad(nlevel,ntime) 357 real dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime) 358 real dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime),hthl(nlevel,ntime) 359 real dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime) 360 real flat(ntime),sens(ntime),ustar(ntime) 361 real uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime) 362 real ts(ntime),ps(ntime) 363 real orog_cas,albedo_cas,emiss_cas,t_skin_cas,q_skin_cas,mom_rough,heat_rough,o3_cas,rugos_cas,clay_cas,sand_cas 364 real apbp(nlevel+1),resul(nlevel,ntime),resul1(nlevel),resul2(ntime),resul3 365 366 367 integer nid, ierr,ierr1,ierr2,rid,i,int_test 368 integer nbvar3d 369 parameter(nbvar3d=78) 370 integer var3didin(nbvar3d),missing_var(nbvar3d) 371 character*13 name_var(1:nbvar3d) 372 373 374 ! data name_var/ & 375 ! ! coordonnees pression (n+1 niveaux) #4 376 ! & 'coor_par_a','coor_par_b','height_h','pressure_h',& ! #1-#4 377 ! ! coordonnees pression (n niveaux) #8 378 ! &'temp','qv','ql','qi','u','v','tke','pressure',& ! #5-#12 379 ! ! coordonnees pression + temps #42 380 ! &'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','temp_adv','tadvh','tadvv',& ! #13 - #25 381 ! &'qv_adv','qvadvh','qvadvv','thadv','thadvh','thadvv','thladvh', & ! #26 - #32 382 ! & 'radv','radvh','radvv','radcool','q1','q2','ustress','vstress', & ! #33 - #40 383 ! & 'rh','temp_nudging','qv_nudging','u_nudging','v_nudging', & ! #41-45 384 ! &'height_f','pressure_forc','tempt','theta','thv','thl','qvt','qlt','qit','rv','ut','vt', & ! #46-58 385 ! ! coordonnees temps #12 386 ! &'tkes','sfc_sens_flx','sfc_lat_flx','ts','ps','ustar',& 387 ! &'orog','albedo','emiss','t_skin','q_skin','mom_rough','heat_rough',& 388 ! ! scalaires #4 389 ! &'o3','rugos','clay','sand'/ 390 391 392 393 data name_var/ & 394 ! coordonnees pression (n+1 niveaux) #4 395 'coor_par_a','coor_par_b','zf','pressure_h',& ! #1-#4 396 ! coordonnees pression (n niveaux) #8 397 'ta','qv','ql','qi','ua','va','tke','pa',& ! #5-#12 398 ! coordonnees pression + temps #46 399 'wa','wap','ug','vg','tnua_adv','tnua_advh','tnua_advv','tnva_adv','tnva_advh','tnva_advv','tnta_adv','tnta_advh','tnta_advv',& ! #13 - #25 400 'tnqv_adv','tnqv_advh','tnqv_advv','thadv','thadvh','thadvv','thladvh', & ! #26 - #32 401 'radv','radvh','radvv','tnta_rad','q1','q2','ustress','vstress', & ! #33 - #40 402 'rh','ta_nud','qv_nud','ua_nud','va_nud', & ! #41-45 403 'zh_forc','pa_forc','tat','thetat','thetavt','thetalt','qvt','qlt','qit','rv','uat','vat', & ! #46-57 404 'nudging_constant_ta', 'nudging_constant_qv', 'nudging_constant_ua', 'nudging_constant_va', & ! # 58-61 405 ! coordonnees temps #12 406 'tkes','hfss','hfls','ts_forc','ps_forc','ustar', & ! 62-67 407 'orog','albedo','emiss','t_skin','q_skin','z0','z0h', & ! 68-74 408 ! scalaires #4 409 'O3','rugos','clay','sand'/ ! 75-78 410 411 412 !----------------------------------------------------------------------- 413 ! First check that we are using a version > v2 of the 1D standard format 414 ! use the difference between 'temp' (old version) and 'ta' (new version) 415 !----------------------------------------------------------------------- 416 417 418 ierr=NF_INQ_VARID(nid,'ta',int_test) 419 if(ierr/=NF_NOERR) then 420 print*, '++++++++++++++++++++++++++++++' 421 print*, 'variable ta missing in cas.nc ' 422 print*, 'You are probably using an obsolete version of the 1D cases' 423 print*, 'please dowload the last version of the 1D archive from https://lmdz.lmd.jussieu.fr/pub/' 424 print*, '++++++++++++++++++++++++++++++' 425 CALL abort_gcm ('mod_1D_cases_read_std','bad version of 1D directory',0) 426 endif 427 428 !----------------------------------------------------------------------- 429 ! Checking availability of variable #i in the cas.nc file 430 ! missing_var=1 if the variable is missing 431 !----------------------------------------------------------------------- 432 433 do i=1,nbvar3d 434 missing_var(i)=0. 435 ierr=NF_INQ_VARID(nid,name_var(i),var3didin(i)) 436 print*, 'name_var(i)', name_var(i), var3didin(i) 437 if(ierr/=NF_NOERR) then 438 print *,'Variable manquante dans cas.nc:',i,name_var(i) 439 ierr=NF_NOERR 440 missing_var(i)=1 441 else 442 443 !----------------------------------------------------------------------- 444 ! Activating keys depending on the presence of specific variables in cas.nc 445 !----------------------------------------------------------------------- 446 if ( 1 == 1 ) THEN 447 ! A MODIFIER: il faudrait dire nudging_temp mais faut le declarer dans compar1d.h etc... 448 ! if ( name_var(i) == 'temp_nudging' .and. nint(nudging_t)==0) stop 'Nudging inconsistency temp' 449 if ( name_var(i) == 'qv_nud' .and. nint(nudging_qv)==0) stop 'Nudging inconsistency qv' 450 if ( name_var(i) == 'ua_nud' .and. nint(nudging_u)==0) stop 'Nudging inconsistency u' 451 if ( name_var(i) == 'va_nud' .and. nint(nudging_v)==0) stop 'Nudging inconsistency v' 452 ELSE 453 453 print*,'GUIDAGE : CONSISTENCY CHECK DEACTIVATED FOR TESTS of SANDU/REF' 454 ENDIF455 456 !-----------------------------------------------------------------------457 ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)458 !-----------------------------------------------------------------------459 454 ENDIF 455 456 !----------------------------------------------------------------------- 457 ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon) 458 !----------------------------------------------------------------------- 459 if(i.LE.4) then 460 460 #ifdef NC_DOUBLE 461 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp)461 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),apbp) 462 462 #else 463 ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp)463 ierr = NF_GET_VAR_REAL(nid,var3didin(i),apbp) 464 464 #endif 465 print *,'read2_cas(apbp), on a lu ',i,name_var(i)466 if(ierr/=NF_NOERR) then467 print *,'Pb a la lecture de cas.nc: ',name_var(i)468 stop "getvarup"469 endif470 471 !-----------------------------------------------------------------------472 ! Reading 1D (N) vertical varialbes (nlevel,lat,lon)473 !-----------------------------------------------------------------------474 465 print *,'read2_cas(apbp), on a lu ',i,name_var(i) 466 if(ierr/=NF_NOERR) then 467 print *,'Pb a la lecture de cas.nc: ',name_var(i) 468 stop "getvarup" 469 endif 470 471 !----------------------------------------------------------------------- 472 ! Reading 1D (N) vertical varialbes (nlevel,lat,lon) 473 !----------------------------------------------------------------------- 474 else if(i.gt.4.and.i.LE.12) then 475 475 #ifdef NC_DOUBLE 476 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1)476 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul1) 477 477 #else 478 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1)478 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul1) 479 479 #endif 480 print *,'read2_cas(resul1), on a lu ',i,name_var(i)481 if(ierr/=NF_NOERR) then482 print *,'Pb a la lecture de cas.nc: ',name_var(i)483 stop "getvarup"484 endif485 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)486 487 !-----------------------------------------------------------------------488 ! Reading 2D tim-vertical variables (time,nlevel,lat,lon)489 ! TBD : seems to be the same as above.490 !-----------------------------------------------------------------------491 480 print *,'read2_cas(resul1), on a lu ',i,name_var(i) 481 if(ierr/=NF_NOERR) then 482 print *,'Pb a la lecture de cas.nc: ',name_var(i) 483 stop "getvarup" 484 endif 485 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1) 486 487 !----------------------------------------------------------------------- 488 ! Reading 2D tim-vertical variables (time,nlevel,lat,lon) 489 ! TBD : seems to be the same as above. 490 !----------------------------------------------------------------------- 491 else if(i.gt.12.and.i.LE.61) then 492 492 #ifdef NC_DOUBLE 493 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul)493 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul) 494 494 #else 495 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul)495 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul) 496 496 #endif 497 print *,'read2_cas(resul), on a lu ',i,name_var(i)498 if(ierr/=NF_NOERR) then499 print *,'Pb a la lecture de cas.nc: ',name_var(i)500 stop "getvarup"501 endif502 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)503 504 !-----------------------------------------------------------------------505 ! Reading 1D time variables (time,lat,lon)506 !-----------------------------------------------------------------------507 497 print *,'read2_cas(resul), on a lu ',i,name_var(i) 498 if(ierr/=NF_NOERR) then 499 print *,'Pb a la lecture de cas.nc: ',name_var(i) 500 stop "getvarup" 501 endif 502 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul) 503 504 !----------------------------------------------------------------------- 505 ! Reading 1D time variables (time,lat,lon) 506 !----------------------------------------------------------------------- 507 else if (i.gt.62.and.i.LE.75) then 508 508 #ifdef NC_DOUBLE 509 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2)509 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul2) 510 510 #else 511 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2)511 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul2) 512 512 #endif 513 print *,'read2_cas(resul2), on a lu ',i,name_var(i)514 if(ierr/=NF_NOERR) then515 print *,'Pb a la lecture de cas.nc: ',name_var(i)516 stop "getvarup"517 endif518 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2)519 520 !-----------------------------------------------------------------------521 ! Reading scalar variables (lat,lon)522 !-----------------------------------------------------------------------523 513 print *,'read2_cas(resul2), on a lu ',i,name_var(i) 514 if(ierr/=NF_NOERR) then 515 print *,'Pb a la lecture de cas.nc: ',name_var(i) 516 stop "getvarup" 517 endif 518 print*,'Lecture de la variable #i ',i,name_var(i),minval(resul2),maxval(resul2) 519 520 !----------------------------------------------------------------------- 521 ! Reading scalar variables (lat,lon) 522 !----------------------------------------------------------------------- 523 else 524 524 #ifdef NC_DOUBLE 525 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3)525 ierr = NF_GET_VAR_DOUBLE(nid,var3didin(i),resul3) 526 526 #else 527 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3)527 ierr = NF_GET_VAR_REAL(nid,var3didin(i),resul3) 528 528 #endif 529 print *,'read2_cas(resul3), on a lu ',i,name_var(i) 530 if(ierr/=NF_NOERR) then 531 print *,'Pb a la lecture de cas.nc: ',name_var(i) 532 stop "getvarup" 533 endif 534 print*,'Lecture de la variable #i ',i,name_var(i),resul3 535 endif 536 endif 537 538 !----------------------------------------------------------------------- 539 ! Attributing variables 540 !----------------------------------------------------------------------- 541 select case(i) 542 !case(1) ; ap=apbp ! donnees indexees en nlevel+1 543 ! case(2) ; bp=apbp 544 case(3) ; zzh=apbp 545 case(4) ; pph=apbp 546 case(5) ; temp0=resul1 ! donnees initiales 547 case(6) ; qv0=resul1 548 case(7) ; ql0=resul1 549 case(8) ; qi0=resul1 550 case(9) ; u0=resul1 551 case(10) ; v0=resul1 552 case(11) ; tke0=resul1 553 case(12) ; pp0=resul1 554 case(13) ; vitw=resul ! donnees indexees en nlevel,time 555 case(14) ; omega=resul 556 case(15) ; ug=resul 557 case(16) ; vg=resul 558 case(17) ; du=resul 559 case(18) ; hu=resul 560 case(19) ; vu=resul 561 case(20) ; dv=resul 562 case(21) ; hv=resul 563 case(22) ; vv=resul 564 case(23) ; dt=resul 565 case(24) ; ht=resul 566 case(25) ; vt=resul 567 case(26) ; dq=resul 568 case(27) ; hq=resul 569 case(28) ; vq=resul 570 case(29) ; dth=resul 571 case(30) ; hth=resul 572 case(31) ; vth=resul 573 case(32) ; hthl=resul 574 case(33) ; dr=resul 575 case(34) ; hr=resul 576 case(35) ; vr=resul 577 case(36) ; dtrad=resul 578 case(37) ; q1=resul 579 case(38) ; q2=resul 580 case(39) ; uw=resul 581 case(40) ; vw=resul 582 case(41) ; rh=resul 583 case(42) ; temp_nudg=resul 584 case(43) ; qv_nudg=resul 585 case(44) ; u_nudg=resul 586 case(45) ; v_nudg=resul 587 case(46) ; zz=resul ! donnees en time,nlevel pour profil initial 588 case(47) ; pp=resul 589 case(48) ; temp=resul 590 case(49) ; theta=resul 591 case(50) ; thv=resul 592 case(51) ; thl=resul 593 case(52) ; qv=resul 594 case(53) ; ql=resul 595 case(54) ; qi=resul 596 case(55) ; rv=resul 597 case(56) ; u=resul 598 case(57) ; v=resul 599 case(58) ; invtau_temp_nudg=resul 600 case(59) ; invtau_qv_nudg=resul 601 case(60) ; invtau_u_nudg=resul 602 case(61) ; invtau_v_nudg=resul 603 case(62) ; tkes=resul2 ! donnees indexees en time 604 case(63) ; sens=resul2 605 case(64) ; flat=resul2 606 case(65) ; ts=resul2 607 case(66) ; ps=resul2 608 case(67) ; ustar=resul2 609 case(68) ; orog_cas=resul3 ! constantes 610 case(69) ; albedo_cas=resul3 611 case(70) ; emiss_cas=resul3 612 case(71) ; t_skin_cas=resul3 613 case(72) ; q_skin_cas=resul3 614 case(73) ; mom_rough=resul3 615 case(74) ; heat_rough=resul3 616 case(75) ; o3_cas=resul3 617 case(76) ; rugos_cas=resul3 618 case(77) ; clay_cas=resul3 619 case(78) ; sand_cas=resul3 620 end select 621 resul=0. 622 resul1=0. 623 resul2=0. 624 resul3=0. 529 print *,'read2_cas(resul3), on a lu ',i,name_var(i) 530 if(ierr/=NF_NOERR) then 531 print *,'Pb a la lecture de cas.nc: ',name_var(i) 532 stop "getvarup" 533 endif 534 print*,'Lecture de la variable #i ',i,name_var(i),resul3 535 endif 536 endif 537 538 !----------------------------------------------------------------------- 539 ! Attributing variables 540 !----------------------------------------------------------------------- 541 select case(i) 542 !case(1) ; ap=apbp ! donnees indexees en nlevel+1 543 ! case(2) ; bp=apbp 544 case(3) ; zzh=apbp 545 case(4) ; pph=apbp 546 case(5) ; temp0=resul1 ! donnees initiales 547 case(6) ; qv0=resul1 548 case(7) ; ql0=resul1 549 case(8) ; qi0=resul1 550 case(9) ; u0=resul1 551 case(10) ; v0=resul1 552 case(11) ; tke0=resul1 553 case(12) ; pp0=resul1 554 case(13) ; vitw=resul ! donnees indexees en nlevel,time 555 case(14) ; omega=resul 556 case(15) ; ug=resul 557 case(16) ; vg=resul 558 case(17) ; du=resul 559 case(18) ; hu=resul 560 case(19) ; vu=resul 561 case(20) ; dv=resul 562 case(21) ; hv=resul 563 case(22) ; vv=resul 564 case(23) ; dt=resul 565 case(24) ; ht=resul 566 case(25) ; vt=resul 567 case(26) ; dq=resul 568 case(27) ; hq=resul 569 case(28) ; vq=resul 570 case(29) ; dth=resul 571 case(30) ; hth=resul 572 case(31) ; vth=resul 573 case(32) ; hthl=resul 574 case(33) ; dr=resul 575 case(34) ; hr=resul 576 case(35) ; vr=resul 577 case(36) ; dtrad=resul 578 case(37) ; q1=resul 579 case(38) ; q2=resul 580 case(39) ; uw=resul 581 case(40) ; vw=resul 582 case(41) ; rh=resul 583 case(42) ; temp_nudg=resul 584 case(43) ; qv_nudg=resul 585 case(44) ; u_nudg=resul 586 case(45) ; v_nudg=resul 587 case(46) ; zz=resul ! donnees en time,nlevel pour profil initial 588 case(47) ; pp=resul 589 case(48) ; temp=resul 590 case(49) ; theta=resul 591 case(50) ; thv=resul 592 case(51) ; thl=resul 593 case(52) ; qv=resul 594 case(53) ; ql=resul 595 case(54) ; qi=resul 596 case(55) ; rv=resul 597 case(56) ; u=resul 598 case(57) ; v=resul 599 case(58) ; invtau_temp_nudg=resul 600 case(59) ; invtau_qv_nudg=resul 601 case(60) ; invtau_u_nudg=resul 602 case(61) ; invtau_v_nudg=resul 603 case(62) ; tkes=resul2 ! donnees indexees en time 604 case(63) ; sens=resul2 605 case(64) ; flat=resul2 606 case(65) ; ts=resul2 607 case(66) ; ps=resul2 608 case(67) ; ustar=resul2 609 case(68) ; orog_cas=resul3 ! constantes 610 case(69) ; albedo_cas=resul3 611 case(70) ; emiss_cas=resul3 612 case(71) ; t_skin_cas=resul3 613 case(72) ; q_skin_cas=resul3 614 case(73) ; mom_rough=resul3 615 case(74) ; heat_rough=resul3 616 case(75) ; o3_cas=resul3 617 case(76) ; rugos_cas=resul3 618 case(77) ; clay_cas=resul3 619 case(78) ; sand_cas=resul3 620 end select 621 resul=0. 622 resul1=0. 623 resul2=0. 624 resul3=0. 625 enddo 626 print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens) 627 print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat) 628 629 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL 630 do t=1,ntime 631 do k=1,nlevel 632 temp(k,t)=temp0(k) 633 qv(k,t)=qv0(k) 634 ql(k,t)=ql0(k) 635 qi(k,t)=qi0(k) 636 u(k,t)=u0(k) 637 v(k,t)=v0(k) 638 tke(k,t)=tke0(k) 625 639 enddo 626 print*,'Lecture de la variable APRES ,sens ',minval(sens),maxval(sens) 627 print*,'Lecture de la variable APRES ,flat ',minval(flat),maxval(flat) 628 629 !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL 630 do t=1,ntime 631 do k=1,nlevel 632 temp(k,t)=temp0(k) 633 qv(k,t)=qv0(k) 634 ql(k,t)=ql0(k) 635 qi(k,t)=qi0(k) 636 u(k,t)=u0(k) 637 v(k,t)=v0(k) 638 tke(k,t)=tke0(k) 639 enddo 640 enddo 641 !!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W 642 !!!omega=-vitw*pres*rg/(rd*temp) 643 !----------------------------------------------------------------------- 644 645 return 646 END SUBROUTINE read_SCM 647 !====================================================================== 648 649 !====================================================================== 650 651 !********************************************************************************************** 652 653 !********************************************************************************************** 654 SUBROUTINE interp_case_time_std(day,day1,annee_ref & 655 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 656 ,nt_cas,nlev_cas & 657 ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas & 658 ,qv_cas,ql_cas,qi_cas,u_cas,v_cas & 659 ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas & 660 ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas & 661 ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas & 662 ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 663 ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas & 664 ,lat_cas,sens_cas,ustar_cas & 665 ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas & 666 ! 667 ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas & 668 ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & 669 ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 670 ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & 671 ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas & 672 ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 673 ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 674 ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 675 ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas & 676 ,lat_prof_cas,sens_prof_cas & 677 ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas) 678 679 680 681 682 683 684 implicit none 685 686 !--------------------------------------------------------------------------------------- 687 ! Time interpolation of a 2D field to the timestep corresponding to day 688 ! 689 ! day: current julian day (e.g. 717538.2) 690 ! day1: first day of the simulation 691 ! nt_cas: total nb of data in the forcing 692 ! pdt_cas: total time interval (in sec) between 2 forcing data 693 !--------------------------------------------------------------------------------------- 640 enddo 641 !!!! TRAVAIL : EN FONCTION DES DECISIONS SUR LA SPECIFICATION DE W 642 !!!omega=-vitw*pres*rg/(rd*temp) 643 !----------------------------------------------------------------------- 644 645 return 646 END SUBROUTINE read_SCM 647 !====================================================================== 648 649 !====================================================================== 650 651 !********************************************************************************************** 652 653 !********************************************************************************************** 654 SUBROUTINE interp_case_time_std(day,day1,annee_ref & 655 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 656 ,nt_cas,nlev_cas & 657 ,ts_cas,ps_cas,plev_cas,t_cas,theta_cas,thv_cas,thl_cas & 658 ,qv_cas,ql_cas,qi_cas,u_cas,v_cas & 659 ,ug_cas,vg_cas,temp_nudg_cas,qv_nudg_cas,u_nudg_cas,v_nudg_cas & 660 ,invtau_temp_nudg_cas,invtau_qv_nudg_cas,invtau_u_nudg_cas,invtau_v_nudg_cas & 661 ,vitw_cas,omega_cas,tke_cas,du_cas,hu_cas,vu_cas & 662 ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 663 ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas & 664 ,lat_cas,sens_cas,ustar_cas & 665 ,uw_cas,vw_cas,q1_cas,q2_cas,tkes_cas & 666 ! 667 ,ts_prof_cas,ps_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas & 668 ,thv_prof_cas,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & 669 ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 670 ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & 671 ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas & 672 ,vitw_prof_cas,omega_prof_cas,tke_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 673 ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 674 ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 675 ,hq_prof_cas,vq_prof_cas,dth_prof_cas,hth_prof_cas,vth_prof_cas & 676 ,lat_prof_cas,sens_prof_cas & 677 ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tkes_prof_cas) 678 679 680 681 682 683 684 implicit none 685 686 !--------------------------------------------------------------------------------------- 687 ! Time interpolation of a 2D field to the timestep corresponding to day 688 ! 689 ! day: current julian day (e.g. 717538.2) 690 ! day1: first day of the simulation 691 ! nt_cas: total nb of data in the forcing 692 ! pdt_cas: total time interval (in sec) between 2 forcing data 693 !--------------------------------------------------------------------------------------- 694 694 695 695 #include "compar1d.h" 696 696 #include "date_cas.h" 697 697 698 ! inputs:699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 ! outputs:727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 ! local:748 749 750 751 752 753 ! do k=1,nlev_cas754 ! print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1)755 ! enddo756 757 ! On teste si la date du cas AMMA est correcte.758 ! C est pour memoire car en fait les fichiers .def759 ! sont censes etre corrects.760 ! A supprimer a terme (MPL 20150623)761 ! if ((forcing_type.eq.10).and.(1.eq.0)) then762 ! Check that initial day of the simulation consistent with AMMA case:763 ! if (annee_ref.ne.2006) then764 ! print*,'Pour AMMA, annee_ref doit etre 2006'765 ! print*,'Changer annee_ref dans run.def'766 ! stop767 ! endif768 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then769 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas770 ! print*,'Changer dayref dans run.def'771 ! stop772 ! endif773 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then774 ! print*,'AMMA a fini le 11 juillet'775 ! print*,'Changer dayref ou nday dans run.def'776 ! stop777 ! endif778 ! endif779 780 ! Determine timestep relative to the 1st day:781 ! timeit=(day-day1)*86400.782 ! if (annee_ref.eq.1992) then783 ! timeit=(day-day_cas)*86400.784 ! else785 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992786 ! endif787 788 789 790 791 792 793 794 ! Determine the closest observation times:795 ! it_cas1=INT(timeit/pdt_cas)+1796 ! it_cas2=it_cas1 + 1797 ! time_cas1=(it_cas1-1)*pdt_cas798 ! time_cas2=(it_cas2-1)*pdt_cas799 800 801 698 ! inputs: 699 integer annee_ref 700 integer nt_cas,nlev_cas 701 real day, day1,day_cas 702 real ts_cas(nt_cas),ps_cas(nt_cas) 703 real plev_cas(nlev_cas,nt_cas) 704 real t_cas(nlev_cas,nt_cas),theta_cas(nlev_cas,nt_cas) 705 real thv_cas(nlev_cas,nt_cas), thl_cas(nlev_cas,nt_cas) 706 real qv_cas(nlev_cas,nt_cas),ql_cas(nlev_cas,nt_cas),qi_cas(nlev_cas,nt_cas) 707 real u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas) 708 real ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas) 709 real temp_nudg_cas(nlev_cas,nt_cas),qv_nudg_cas(nlev_cas,nt_cas) 710 real u_nudg_cas(nlev_cas,nt_cas),v_nudg_cas(nlev_cas,nt_cas) 711 712 real invtau_temp_nudg_cas(nlev_cas,nt_cas),invtau_qv_nudg_cas(nlev_cas,nt_cas) 713 real invtau_u_nudg_cas(nlev_cas,nt_cas),invtau_v_nudg_cas(nlev_cas,nt_cas) 714 715 real vitw_cas(nlev_cas,nt_cas),omega_cas(nlev_cas,nt_cas),tke_cas(nlev_cas,nt_cas) 716 real du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas) 717 real dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas) 718 real dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas) 719 real dth_cas(nlev_cas,nt_cas),hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas) 720 real dtrad_cas(nlev_cas,nt_cas) 721 real dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas) 722 real lat_cas(nt_cas),sens_cas(nt_cas),tkes_cas(nt_cas) 723 real ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas) 724 real q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas) 725 726 ! outputs: 727 real plev_prof_cas(nlev_cas) 728 real t_prof_cas(nlev_cas),theta_prof_cas(nlev_cas),thl_prof_cas(nlev_cas),thv_prof_cas(nlev_cas) 729 real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas) 730 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 731 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas) 732 real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas) 733 real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas) 734 735 real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas) 736 real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas) 737 738 real vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas) 739 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 740 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 741 real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas) 742 real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas) 743 real dtrad_prof_cas(nlev_cas) 744 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 745 real lat_prof_cas,sens_prof_cas,tkes_prof_cas,ts_prof_cas,ps_prof_cas,ustar_prof_cas 746 real uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas) 747 ! local: 748 integer it_cas1, it_cas2,k 749 real timeit,time_cas1,time_cas2,frac 750 751 752 print*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas 753 ! do k=1,nlev_cas 754 ! print*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1) 755 ! enddo 756 757 ! On teste si la date du cas AMMA est correcte. 758 ! C est pour memoire car en fait les fichiers .def 759 ! sont censes etre corrects. 760 ! A supprimer a terme (MPL 20150623) 761 ! if ((forcing_type.eq.10).and.(1.eq.0)) then 762 ! Check that initial day of the simulation consistent with AMMA case: 763 ! if (annee_ref.ne.2006) then 764 ! print*,'Pour AMMA, annee_ref doit etre 2006' 765 ! print*,'Changer annee_ref dans run.def' 766 ! stop 767 ! endif 768 ! if (annee_ref.eq.2006 .and. day1.lt.day_cas) then 769 ! print*,'AMMA a debute le 10 juillet 2006',day1,day_cas 770 ! print*,'Changer dayref dans run.def' 771 ! stop 772 ! endif 773 ! if (annee_ref.eq.2006 .and. day1.gt.day_cas+1) then 774 ! print*,'AMMA a fini le 11 juillet' 775 ! print*,'Changer dayref ou nday dans run.def' 776 ! stop 777 ! endif 778 ! endif 779 780 ! Determine timestep relative to the 1st day: 781 ! timeit=(day-day1)*86400. 782 ! if (annee_ref.eq.1992) then 783 ! timeit=(day-day_cas)*86400. 784 ! else 785 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 786 ! endif 787 timeit=(day-day_ju_ini_cas)*86400 788 print *,'day=',day 789 print *,'day_ju_ini_cas=',day_ju_ini_cas 790 print *,'pdt_cas=',pdt_cas 791 print *,'timeit=',timeit 792 print *,'nt_cas=',nt_cas 793 794 ! Determine the closest observation times: 795 ! it_cas1=INT(timeit/pdt_cas)+1 796 ! it_cas2=it_cas1 + 1 797 ! time_cas1=(it_cas1-1)*pdt_cas 798 ! time_cas2=(it_cas2-1)*pdt_cas 799 800 it_cas1=INT(timeit/pdt_cas)+1 801 IF (it_cas1 .EQ. nt_cas) THEN 802 802 it_cas2=it_cas1 803 803 ELSE 804 804 it_cas2=it_cas1 + 1 805 806 807 808 ! print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas809 ! print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2810 811 812 813 814 815 816 817 ! time interpolation:818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 805 ENDIF 806 time_cas1=(it_cas1-1)*pdt_cas 807 time_cas2=(it_cas2-1)*pdt_cas 808 ! print *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas 809 ! print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2 810 811 if (it_cas1 .gt. nt_cas) then 812 write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & 813 ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit 814 stop 815 endif 816 817 ! time interpolation: 818 IF (it_cas1 .EQ. it_cas2) THEN 819 frac=0. 820 ELSE 821 frac=(time_cas2-timeit)/(time_cas2-time_cas1) 822 frac=max(frac,0.0) 823 ENDIF 824 825 lat_prof_cas = lat_cas(it_cas2) & 826 -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 827 sens_prof_cas = sens_cas(it_cas2) & 828 -frac*(sens_cas(it_cas2)-sens_cas(it_cas1)) 829 tkes_prof_cas = tkes_cas(it_cas2) & 830 -frac*(tkes_cas(it_cas2)-tkes_cas(it_cas1)) 831 ts_prof_cas = ts_cas(it_cas2) & 832 -frac*(ts_cas(it_cas2)-ts_cas(it_cas1)) 833 ps_prof_cas = ps_cas(it_cas2) & 834 -frac*(ps_cas(it_cas2)-ps_cas(it_cas1)) 835 ustar_prof_cas = ustar_cas(it_cas2) & 836 -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1)) 837 838 do k=1,nlev_cas 839 plev_prof_cas(k) = plev_cas(k,it_cas2) & 840 -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1)) 841 t_prof_cas(k) = t_cas(k,it_cas2) & 842 -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1)) 843 !print *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2) 844 theta_prof_cas(k) = theta_cas(k,it_cas2) & 845 -frac*(theta_cas(k,it_cas2)-theta_cas(k,it_cas1)) 846 thv_prof_cas(k) = thv_cas(k,it_cas2) & 847 -frac*(thv_cas(k,it_cas2)-thv_cas(k,it_cas1)) 848 thl_prof_cas(k) = thl_cas(k,it_cas2) & 849 -frac*(thl_cas(k,it_cas2)-thl_cas(k,it_cas1)) 850 qv_prof_cas(k) = qv_cas(k,it_cas2) & 851 -frac*(qv_cas(k,it_cas2)-qv_cas(k,it_cas1)) 852 ql_prof_cas(k) = ql_cas(k,it_cas2) & 853 -frac*(ql_cas(k,it_cas2)-ql_cas(k,it_cas1)) 854 qi_prof_cas(k) = qi_cas(k,it_cas2) & 855 -frac*(qi_cas(k,it_cas2)-qi_cas(k,it_cas1)) 856 u_prof_cas(k) = u_cas(k,it_cas2) & 857 -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1)) 858 v_prof_cas(k) = v_cas(k,it_cas2) & 859 -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1)) 860 ug_prof_cas(k) = ug_cas(k,it_cas2) & 861 -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1)) 862 vg_prof_cas(k) = vg_cas(k,it_cas2) & 863 -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1)) 864 temp_nudg_prof_cas(k) = temp_nudg_cas(k,it_cas2) & 865 -frac*(temp_nudg_cas(k,it_cas2)-temp_nudg_cas(k,it_cas1)) 866 qv_nudg_prof_cas(k) = qv_nudg_cas(k,it_cas2) & 867 -frac*(qv_nudg_cas(k,it_cas2)-qv_nudg_cas(k,it_cas1)) 868 u_nudg_prof_cas(k) = u_nudg_cas(k,it_cas2) & 869 -frac*(u_nudg_cas(k,it_cas2)-u_nudg_cas(k,it_cas1)) 870 v_nudg_prof_cas(k) = v_nudg_cas(k,it_cas2) & 871 -frac*(v_nudg_cas(k,it_cas2)-v_nudg_cas(k,it_cas1)) 872 invtau_temp_nudg_prof_cas(k) = invtau_temp_nudg_cas(k,it_cas2) & 873 -frac*(invtau_temp_nudg_cas(k,it_cas2)-invtau_temp_nudg_cas(k,it_cas1)) 874 invtau_qv_nudg_prof_cas(k) = invtau_qv_nudg_cas(k,it_cas2) & 875 -frac*(invtau_qv_nudg_cas(k,it_cas2)-invtau_qv_nudg_cas(k,it_cas1)) 876 invtau_u_nudg_prof_cas(k) = invtau_u_nudg_cas(k,it_cas2) & 877 -frac*(invtau_u_nudg_cas(k,it_cas2)-invtau_u_nudg_cas(k,it_cas1)) 878 invtau_v_nudg_prof_cas(k) = invtau_v_nudg_cas(k,it_cas2) & 879 -frac*(invtau_v_nudg_cas(k,it_cas2)-invtau_v_nudg_cas(k,it_cas1)) 880 vitw_prof_cas(k) = vitw_cas(k,it_cas2) & 881 -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1)) 882 omega_prof_cas(k) = omega_cas(k,it_cas2) & 883 -frac*(omega_cas(k,it_cas2)-omega_cas(k,it_cas1)) 884 tke_prof_cas(k) = tke_cas(k,it_cas2) & 885 -frac*(tke_cas(k,it_cas2)-tke_cas(k,it_cas1)) 886 du_prof_cas(k) = du_cas(k,it_cas2) & 887 -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1)) 888 hu_prof_cas(k) = hu_cas(k,it_cas2) & 889 -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1)) 890 vu_prof_cas(k) = vu_cas(k,it_cas2) & 891 -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1)) 892 dv_prof_cas(k) = dv_cas(k,it_cas2) & 893 -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1)) 894 hv_prof_cas(k) = hv_cas(k,it_cas2) & 895 -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1)) 896 vv_prof_cas(k) = vv_cas(k,it_cas2) & 897 -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1)) 898 dt_prof_cas(k) = dt_cas(k,it_cas2) & 899 -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1)) 900 ht_prof_cas(k) = ht_cas(k,it_cas2) & 901 -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1)) 902 vt_prof_cas(k) = vt_cas(k,it_cas2) & 903 -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1)) 904 dth_prof_cas(k) = dth_cas(k,it_cas2) & 905 -frac*(dth_cas(k,it_cas2)-dth_cas(k,it_cas1)) 906 hth_prof_cas(k) = hth_cas(k,it_cas2) & 907 -frac*(hth_cas(k,it_cas2)-hth_cas(k,it_cas1)) 908 vth_prof_cas(k) = vth_cas(k,it_cas2) & 909 -frac*(vth_cas(k,it_cas2)-vth_cas(k,it_cas1)) 910 dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) & 911 -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1)) 912 dq_prof_cas(k) = dq_cas(k,it_cas2) & 913 -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1)) 914 hq_prof_cas(k) = hq_cas(k,it_cas2) & 915 -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1)) 916 vq_prof_cas(k) = vq_cas(k,it_cas2) & 917 -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1)) 918 918 uw_prof_cas(k) = uw_cas(k,it_cas2) & 919 919 -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1)) 920 920 vw_prof_cas(k) = vw_cas(k,it_cas2) & 921 921 -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1)) 922 922 q1_prof_cas(k) = q1_cas(k,it_cas2) & 923 923 -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1)) 924 924 q2_prof_cas(k) = q2_cas(k,it_cas2) & 925 926 927 928 929 930 931 !**********************************************************************************************932 !=====================================================================933 934 935 936 937 938 939 940 941 942 943 !944 945 946 947 948 949 950 951 952 953 954 955 925 -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1)) 926 enddo 927 928 return 929 END SUBROUTINE interp_case_time_std 930 931 !********************************************************************************************** 932 !===================================================================== 933 SUBROUTINE interp2_case_vertical_std(play,plev,nlev_cas,plev_prof_cas & 934 ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas & 935 ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & 936 ,ug_prof_cas,vg_prof_cas & 937 ,temp_nudg_prof_cas,qv_nudg_prof_cas,u_nudg_prof_cas,v_nudg_prof_cas & 938 ,invtau_temp_nudg_prof_cas,invtau_qv_nudg_prof_cas,invtau_u_nudg_prof_cas,invtau_v_nudg_prof_cas & 939 ,vitw_prof_cas,omega_prof_cas,tke_prof_cas & 940 ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 941 ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 942 ,dth_prof_cas,hth_prof_cas,vth_prof_cas & 943 ! 944 ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas & 945 ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas & 946 ,ug_mod_cas,vg_mod_cas & 947 ,temp_nudg_mod_cas,qv_nudg_mod_cas,u_nudg_mod_cas,v_nudg_mod_cas & 948 ,invtau_temp_nudg_mod_cas,invtau_qv_nudg_mod_cas,invtau_u_nudg_mod_cas,invtau_v_nudg_mod_cas & 949 ,w_mod_cas,omega_mod_cas,tke_mod_cas & 950 ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 951 ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & 952 ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc) 953 954 implicit none 955 956 956 #include "YOMCST.h" 957 957 #include "dimensions.h" 958 958 959 !-------------------------------------------------------------------------960 ! Vertical interpolation of generic case forcing data onto mod_casel levels961 !-------------------------------------------------------------------------962 963 964 965 966 ! real play(llm), plev_prof(nlevmax)967 ! real t_prof(nlevmax),q_prof(nlevmax)968 ! real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)969 ! real ht_prof(nlevmax),vt_prof(nlevmax)970 ! real hq_prof(nlevmax),vq_prof(nlevmax)971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 ! for variables defined at the middle of layers1008 1009 1010 1011 1012 1013 mxcalc=l1014 ! print *,'debut interp2, mxcalc=',mxcalc1015 k1=01016 k2=01017 1018 if (play(l).le.plev_prof_cas(1)) then1019 1020 do k = 1, nlev_cas-11021 if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then1022 k1=k1023 k2=k+11024 endif1025 enddo1026 1027 if (k1.eq.0 .or. k2.eq.0) then1028 write(*,*) 'PB! k1, k2 = ',k1,k21029 write(*,*) 'l,play(l) = ',l,play(l)/1001030 do k = 1, nlev_cas-11031 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/1001032 enddo1033 endif1034 1035 1036 1037 frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))1038 1039 t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))1040 theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))1041 if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)1042 thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))1043 thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))1044 qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))1045 ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))1046 qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))1047 u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))1048 v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))1049 ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))1050 vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))1051 temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1))1052 qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1))1053 u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1))1054 v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1))1055 1056 invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(k2) - frac*(invtau_temp_nudg_prof_cas(k2)-invtau_temp_nudg_prof_cas(k1))1057 invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(k2) - frac*(invtau_qv_nudg_prof_cas(k2)-invtau_qv_nudg_prof_cas(k1))1058 invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(k2) - frac*(invtau_u_nudg_prof_cas(k2)-invtau_u_nudg_prof_cas(k1))1059 invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(k2) - frac*(invtau_v_nudg_prof_cas(k2)-invtau_v_nudg_prof_cas(k1))1060 1061 w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))1062 omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))1063 du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))1064 hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))1065 vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))1066 dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))1067 hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))1068 vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))1069 dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))1070 ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))1071 vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))1072 dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))1073 hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))1074 vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))1075 dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))1076 hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))1077 vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))1078 dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1))1079 1080 else !play>plev_prof_cas(1)1081 1082 k1=11083 k2=21084 print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)1085 frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))1086 frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))1087 t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)1088 theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)1089 if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)1090 thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)1091 thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)1092 qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2)1093 ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2)1094 qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2)1095 u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)1096 v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)1097 ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)1098 vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)1099 temp_nudg_mod_cas(l)= frac1*temp_nudg_prof_cas(k1) - frac2*temp_nudg_prof_cas(k2)1100 qv_nudg_mod_cas(l)= frac1*qv_nudg_prof_cas(k1) - frac2*qv_nudg_prof_cas(k2)1101 u_nudg_mod_cas(l)= frac1*u_nudg_prof_cas(k1) - frac2*u_nudg_prof_cas(k2)1102 v_nudg_mod_cas(l)= frac1*v_nudg_prof_cas(k1) - frac2*v_nudg_prof_cas(k2)1103 1104 invtau_temp_nudg_mod_cas(l)= frac1*invtau_temp_nudg_prof_cas(k1) - frac2*invtau_temp_nudg_prof_cas(k2)1105 invtau_qv_nudg_mod_cas(l)= frac1*invtau_qv_nudg_prof_cas(k1) - frac2*invtau_qv_nudg_prof_cas(k2)1106 invtau_u_nudg_mod_cas(l)= frac1*invtau_u_nudg_prof_cas(k1) - frac2*invtau_u_nudg_prof_cas(k2)1107 invtau_v_nudg_mod_cas(l)= frac1*invtau_v_nudg_prof_cas(k1) - frac2*invtau_v_nudg_prof_cas(k2)1108 1109 w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)1110 omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2)1111 du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)1112 hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)1113 vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)1114 dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)1115 hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)1116 vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)1117 dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)1118 ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)1119 vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)1120 dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2)1121 hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2)1122 vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2)1123 dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)1124 hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)1125 vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)1126 dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2)1127 1128 endif ! play.le.plev_prof_cas(1)1129 1130 1131 1132 !jyg1133 fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg1134 fact = max(fact,0.) !jyg1135 fact = exp(-fact) !jyg1136 t_mod_cas(l)= t_prof_cas(nlev_cas) !jyg1137 theta_mod_cas(l)= th_prof_cas(nlev_cas) !jyg1138 thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg1139 thl_mod_cas(l)= thl_prof_cas(nlev_cas) !jyg1140 qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact !jyg1141 ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact !jyg1142 qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact !jyg1143 u_mod_cas(l)= u_prof_cas(nlev_cas)*fact !jyg1144 v_mod_cas(l)= v_prof_cas(nlev_cas)*fact !jyg1145 ug_mod_cas(l)= ug_prof_cas(nlev_cas) !jyg1146 vg_mod_cas(l)= vg_prof_cas(nlev_cas) !jyg1147 temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas) !jyg1148 qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas) !jyg1149 u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas) !jyg1150 v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas) !jyg1151 1152 invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(nlev_cas) !jyg1153 invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(nlev_cas) !jyg1154 invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(nlev_cas) !jyg1155 invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(nlev_cas) !jyg1156 1157 thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg1158 w_mod_cas(l)= 0.0 !jyg1159 omega_mod_cas(l)= 0.0 !jyg1160 du_mod_cas(l)= du_prof_cas(nlev_cas)*fact1161 hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact !jyg1162 vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact !jyg1163 dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact1164 hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact !jyg1165 vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact !jyg1166 dt_mod_cas(l)= dt_prof_cas(nlev_cas)1167 ht_mod_cas(l)= ht_prof_cas(nlev_cas) !jyg1168 vt_mod_cas(l)= vt_prof_cas(nlev_cas) !jyg1169 dth_mod_cas(l)= dth_prof_cas(nlev_cas)1170 hth_mod_cas(l)= hth_prof_cas(nlev_cas) !jyg1171 vth_mod_cas(l)= vth_prof_cas(nlev_cas) !jyg1172 dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact1173 hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact !jyg1174 vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact !jyg1175 dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact !jyg1176 1177 1178 1179 1180 1181 ! for variables defined at layer interfaces (EV):1182 1183 1184 1185 1186 1187 1188 mxcalc=l1189 k1=01190 k2=01191 1192 if (plev(l).le.plev_prof_cas(1)) then1193 1194 do k = 1, nlev_cas-11195 if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then1196 k1=k1197 k2=k+11198 endif1199 enddo1200 1201 if (k1.eq.0 .or. k2.eq.0) then1202 write(*,*) 'PB! k1, k2 = ',k1,k21203 write(*,*) 'l,plev(l) = ',l,plev(l)/1001204 do k = 1, nlev_cas-11205 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/1001206 enddo1207 endif1208 1209 frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))1210 tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1))1211 else !play>plev_prof_cas(1)1212 k1=11213 k2=21214 tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2)1215 1216 endif ! plev.le.plev_prof_cas(1)1217 1218 1219 1220 tke_mod_cas(l)=0.01221 1222 1223 1224 1225 1226 1227 1228 1229 1230 !*****************************************************************************959 !------------------------------------------------------------------------- 960 ! Vertical interpolation of generic case forcing data onto mod_casel levels 961 !------------------------------------------------------------------------- 962 963 integer nlevmax 964 parameter (nlevmax=41) 965 integer nlev_cas,mxcalc 966 ! real play(llm), plev_prof(nlevmax) 967 ! real t_prof(nlevmax),q_prof(nlevmax) 968 ! real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax) 969 ! real ht_prof(nlevmax),vt_prof(nlevmax) 970 ! real hq_prof(nlevmax),vq_prof(nlevmax) 971 972 real play(llm), plev(llm+1), plev_prof_cas(nlev_cas) 973 real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas) 974 real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas) 975 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 976 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas),tke_prof_cas(nlev_cas) 977 real temp_nudg_prof_cas(nlev_cas),qv_nudg_prof_cas(nlev_cas) 978 real u_nudg_prof_cas(nlev_cas),v_nudg_prof_cas(nlev_cas) 979 real invtau_temp_nudg_prof_cas(nlev_cas),invtau_qv_nudg_prof_cas(nlev_cas) 980 real invtau_u_nudg_prof_cas(nlev_cas),invtau_v_nudg_prof_cas(nlev_cas) 981 982 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 983 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 984 real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas) 985 real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas) 986 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 987 988 real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm) 989 real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm) 990 real u_mod_cas(llm),v_mod_cas(llm) 991 real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm),tke_mod_cas(llm+1) 992 real temp_nudg_mod_cas(llm),qv_nudg_mod_cas(llm) 993 real u_nudg_mod_cas(llm),v_nudg_mod_cas(llm) 994 real invtau_temp_nudg_mod_cas(llm),invtau_qv_nudg_mod_cas(llm) 995 real invtau_u_nudg_mod_cas(llm),invtau_v_nudg_mod_cas(llm) 996 real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm) 997 real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm) 998 real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm) 999 real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm) 1000 real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm) 1001 1002 integer l,k,k1,k2 1003 real frac,frac1,frac2,fact 1004 1005 1006 1007 ! for variables defined at the middle of layers 1008 1009 do l = 1, llm 1010 1011 if (play(l).ge.plev_prof_cas(nlev_cas)) then 1012 1013 mxcalc=l 1014 ! print *,'debut interp2, mxcalc=',mxcalc 1015 k1=0 1016 k2=0 1017 1018 if (play(l).le.plev_prof_cas(1)) then 1019 1020 do k = 1, nlev_cas-1 1021 if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then 1022 k1=k 1023 k2=k+1 1024 endif 1025 enddo 1026 1027 if (k1.eq.0 .or. k2.eq.0) then 1028 write(*,*) 'PB! k1, k2 = ',k1,k2 1029 write(*,*) 'l,play(l) = ',l,play(l)/100 1030 do k = 1, nlev_cas-1 1031 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100 1032 enddo 1033 endif 1034 1035 1036 1037 frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1)) 1038 1039 t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1)) 1040 theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1)) 1041 if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD) 1042 thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1)) 1043 thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1)) 1044 qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1)) 1045 ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1)) 1046 qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1)) 1047 u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1)) 1048 v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1)) 1049 ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1)) 1050 vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1)) 1051 temp_nudg_mod_cas(l)= temp_nudg_prof_cas(k2) - frac*(temp_nudg_prof_cas(k2)-temp_nudg_prof_cas(k1)) 1052 qv_nudg_mod_cas(l)= qv_nudg_prof_cas(k2) - frac*(qv_nudg_prof_cas(k2)-qv_nudg_prof_cas(k1)) 1053 u_nudg_mod_cas(l)= u_nudg_prof_cas(k2) - frac*(u_nudg_prof_cas(k2)-u_nudg_prof_cas(k1)) 1054 v_nudg_mod_cas(l)= v_nudg_prof_cas(k2) - frac*(v_nudg_prof_cas(k2)-v_nudg_prof_cas(k1)) 1055 1056 invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(k2) - frac*(invtau_temp_nudg_prof_cas(k2)-invtau_temp_nudg_prof_cas(k1)) 1057 invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(k2) - frac*(invtau_qv_nudg_prof_cas(k2)-invtau_qv_nudg_prof_cas(k1)) 1058 invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(k2) - frac*(invtau_u_nudg_prof_cas(k2)-invtau_u_nudg_prof_cas(k1)) 1059 invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(k2) - frac*(invtau_v_nudg_prof_cas(k2)-invtau_v_nudg_prof_cas(k1)) 1060 1061 w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1)) 1062 omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1)) 1063 du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1)) 1064 hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1)) 1065 vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1)) 1066 dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1)) 1067 hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1)) 1068 vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1)) 1069 dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1)) 1070 ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1)) 1071 vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1)) 1072 dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1)) 1073 hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1)) 1074 vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1)) 1075 dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1)) 1076 hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1)) 1077 vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1)) 1078 dtrad_mod_cas(l)= dtrad_prof_cas(k2) - frac*(dtrad_prof_cas(k2)-dtrad_prof_cas(k1)) 1079 1080 else !play>plev_prof_cas(1) 1081 1082 k1=1 1083 k2=2 1084 print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2) 1085 frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2)) 1086 frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2)) 1087 t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2) 1088 theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2) 1089 if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD) 1090 thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2) 1091 thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2) 1092 qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2) 1093 ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2) 1094 qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2) 1095 u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2) 1096 v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2) 1097 ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2) 1098 vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2) 1099 temp_nudg_mod_cas(l)= frac1*temp_nudg_prof_cas(k1) - frac2*temp_nudg_prof_cas(k2) 1100 qv_nudg_mod_cas(l)= frac1*qv_nudg_prof_cas(k1) - frac2*qv_nudg_prof_cas(k2) 1101 u_nudg_mod_cas(l)= frac1*u_nudg_prof_cas(k1) - frac2*u_nudg_prof_cas(k2) 1102 v_nudg_mod_cas(l)= frac1*v_nudg_prof_cas(k1) - frac2*v_nudg_prof_cas(k2) 1103 1104 invtau_temp_nudg_mod_cas(l)= frac1*invtau_temp_nudg_prof_cas(k1) - frac2*invtau_temp_nudg_prof_cas(k2) 1105 invtau_qv_nudg_mod_cas(l)= frac1*invtau_qv_nudg_prof_cas(k1) - frac2*invtau_qv_nudg_prof_cas(k2) 1106 invtau_u_nudg_mod_cas(l)= frac1*invtau_u_nudg_prof_cas(k1) - frac2*invtau_u_nudg_prof_cas(k2) 1107 invtau_v_nudg_mod_cas(l)= frac1*invtau_v_nudg_prof_cas(k1) - frac2*invtau_v_nudg_prof_cas(k2) 1108 1109 w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2) 1110 omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2) 1111 du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2) 1112 hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2) 1113 vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2) 1114 dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2) 1115 hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2) 1116 vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2) 1117 dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2) 1118 ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2) 1119 vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2) 1120 dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2) 1121 hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2) 1122 vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2) 1123 dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2) 1124 hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2) 1125 vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2) 1126 dtrad_mod_cas(l)= frac1*dtrad_prof_cas(k1) - frac2*dtrad_prof_cas(k2) 1127 1128 endif ! play.le.plev_prof_cas(1) 1129 1130 else ! above max altitude of forcing file 1131 1132 !jyg 1133 fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg 1134 fact = max(fact,0.) !jyg 1135 fact = exp(-fact) !jyg 1136 t_mod_cas(l)= t_prof_cas(nlev_cas) !jyg 1137 theta_mod_cas(l)= th_prof_cas(nlev_cas) !jyg 1138 thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg 1139 thl_mod_cas(l)= thl_prof_cas(nlev_cas) !jyg 1140 qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact !jyg 1141 ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact !jyg 1142 qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact !jyg 1143 u_mod_cas(l)= u_prof_cas(nlev_cas)*fact !jyg 1144 v_mod_cas(l)= v_prof_cas(nlev_cas)*fact !jyg 1145 ug_mod_cas(l)= ug_prof_cas(nlev_cas) !jyg 1146 vg_mod_cas(l)= vg_prof_cas(nlev_cas) !jyg 1147 temp_nudg_mod_cas(l)= temp_nudg_prof_cas(nlev_cas) !jyg 1148 qv_nudg_mod_cas(l)= qv_nudg_prof_cas(nlev_cas) !jyg 1149 u_nudg_mod_cas(l)= u_nudg_prof_cas(nlev_cas) !jyg 1150 v_nudg_mod_cas(l)= v_nudg_prof_cas(nlev_cas) !jyg 1151 1152 invtau_temp_nudg_mod_cas(l)= invtau_temp_nudg_prof_cas(nlev_cas) !jyg 1153 invtau_qv_nudg_mod_cas(l)= invtau_qv_nudg_prof_cas(nlev_cas) !jyg 1154 invtau_u_nudg_mod_cas(l)= invtau_u_nudg_prof_cas(nlev_cas) !jyg 1155 invtau_v_nudg_mod_cas(l)= invtau_v_nudg_prof_cas(nlev_cas) !jyg 1156 1157 thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg 1158 w_mod_cas(l)= 0.0 !jyg 1159 omega_mod_cas(l)= 0.0 !jyg 1160 du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 1161 hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact !jyg 1162 vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact !jyg 1163 dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact 1164 hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact !jyg 1165 vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact !jyg 1166 dt_mod_cas(l)= dt_prof_cas(nlev_cas) 1167 ht_mod_cas(l)= ht_prof_cas(nlev_cas) !jyg 1168 vt_mod_cas(l)= vt_prof_cas(nlev_cas) !jyg 1169 dth_mod_cas(l)= dth_prof_cas(nlev_cas) 1170 hth_mod_cas(l)= hth_prof_cas(nlev_cas) !jyg 1171 vth_mod_cas(l)= vth_prof_cas(nlev_cas) !jyg 1172 dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 1173 hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact !jyg 1174 vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact !jyg 1175 dtrad_mod_cas(l)= dtrad_prof_cas(nlev_cas)*fact !jyg 1176 1177 endif ! play 1178 1179 enddo ! l 1180 1181 ! for variables defined at layer interfaces (EV): 1182 1183 1184 do l = 1, llm+1 1185 1186 if (plev(l).ge.plev_prof_cas(nlev_cas)) then 1187 1188 mxcalc=l 1189 k1=0 1190 k2=0 1191 1192 if (plev(l).le.plev_prof_cas(1)) then 1193 1194 do k = 1, nlev_cas-1 1195 if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then 1196 k1=k 1197 k2=k+1 1198 endif 1199 enddo 1200 1201 if (k1.eq.0 .or. k2.eq.0) then 1202 write(*,*) 'PB! k1, k2 = ',k1,k2 1203 write(*,*) 'l,plev(l) = ',l,plev(l)/100 1204 do k = 1, nlev_cas-1 1205 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100 1206 enddo 1207 endif 1208 1209 frac = (plev_prof_cas(k2)-plev(l))/(plev_prof_cas(k2)-plev_prof_cas(k1)) 1210 tke_mod_cas(l)= tke_prof_cas(k2) - frac*(tke_prof_cas(k2)-tke_prof_cas(k1)) 1211 else !play>plev_prof_cas(1) 1212 k1=1 1213 k2=2 1214 tke_mod_cas(l)= frac1*tke_prof_cas(k1) - frac2*tke_prof_cas(k2) 1215 1216 endif ! plev.le.plev_prof_cas(1) 1217 1218 else ! above max altitude of forcing file 1219 1220 tke_mod_cas(l)=0.0 1221 1222 endif ! plev 1223 1224 enddo ! l 1225 1226 1227 1228 return 1229 end SUBROUTINE interp2_case_vertical_std 1230 !***************************************************************************** 1231 1231 1232 1232
Note: See TracChangeset
for help on using the changeset viewer.
