! $Id: mod_1D_cases_read.F90 2373 2015-10-13 17:28:01Z jyg $ MODULE mod_1D_cases_read2 USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_inq_varid, nf90_inquire_dimension, nf90_strerror, nf90_open, & nf90_nowrite, nf90_inq_dimid !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !Declarations specifiques au cas standard CHARACTER*80 :: fich_cas ! Discr?tisation INTEGER nlev_cas, nt_cas !profils environnementaux REAL, ALLOCATABLE :: plev_cas(:, :), plevh_cas(:) REAL, ALLOCATABLE :: ap_cas(:), bp_cas(:) REAL, ALLOCATABLE :: z_cas(:, :), zh_cas(:) REAL, ALLOCATABLE :: t_cas(:, :), q_cas(:, :), qv_cas(:, :), ql_cas(:, :), qi_cas(:, :), rh_cas(:, :) REAL, ALLOCATABLE :: th_cas(:, :), thv_cas(:, :), thl_cas(:, :), rv_cas(:, :) REAL, ALLOCATABLE :: u_cas(:, :), v_cas(:, :), vitw_cas(:, :), omega_cas(:, :) !forcing REAL, ALLOCATABLE :: ht_cas(:, :), vt_cas(:, :), dt_cas(:, :), dtrad_cas(:, :) REAL, ALLOCATABLE :: hth_cas(:, :), vth_cas(:, :), dth_cas(:, :) REAL, ALLOCATABLE :: hq_cas(:, :), vq_cas(:, :), dq_cas(:, :) REAL, ALLOCATABLE :: hr_cas(:, :), vr_cas(:, :), dr_cas(:, :) REAL, ALLOCATABLE :: hu_cas(:, :), vu_cas(:, :), du_cas(:, :) REAL, ALLOCATABLE :: hv_cas(:, :), vv_cas(:, :), dv_cas(:, :) REAL, ALLOCATABLE :: ug_cas(:, :), vg_cas(:, :) REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), ts_cas(:), ps_cas(:), ustar_cas(:) REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :), tke_cas(:) !champs interpoles REAL, ALLOCATABLE :: plev_prof_cas(:) REAL, ALLOCATABLE :: t_prof_cas(:) REAL, ALLOCATABLE :: theta_prof_cas(:) REAL, ALLOCATABLE :: thl_prof_cas(:) REAL, ALLOCATABLE :: thv_prof_cas(:) REAL, ALLOCATABLE :: q_prof_cas(:) REAL, ALLOCATABLE :: qv_prof_cas(:) REAL, ALLOCATABLE :: ql_prof_cas(:) REAL, ALLOCATABLE :: qi_prof_cas(:) REAL, ALLOCATABLE :: rh_prof_cas(:) REAL, ALLOCATABLE :: rv_prof_cas(:) REAL, ALLOCATABLE :: u_prof_cas(:) REAL, ALLOCATABLE :: v_prof_cas(:) REAL, ALLOCATABLE :: vitw_prof_cas(:) REAL, ALLOCATABLE :: omega_prof_cas(:) REAL, ALLOCATABLE :: ug_prof_cas(:) REAL, ALLOCATABLE :: vg_prof_cas(:) REAL, ALLOCATABLE :: ht_prof_cas(:) REAL, ALLOCATABLE :: hth_prof_cas(:) REAL, ALLOCATABLE :: hq_prof_cas(:) REAL, ALLOCATABLE :: vt_prof_cas(:) REAL, ALLOCATABLE :: vth_prof_cas(:) REAL, ALLOCATABLE :: vq_prof_cas(:) REAL, ALLOCATABLE :: dt_prof_cas(:) REAL, ALLOCATABLE :: dth_prof_cas(:) REAL, ALLOCATABLE :: dtrad_prof_cas(:) REAL, ALLOCATABLE :: dq_prof_cas(:) REAL, ALLOCATABLE :: hu_prof_cas(:) REAL, ALLOCATABLE :: hv_prof_cas(:) REAL, ALLOCATABLE :: vu_prof_cas(:) REAL, ALLOCATABLE :: vv_prof_cas(:) REAL, ALLOCATABLE :: du_prof_cas(:) REAL, ALLOCATABLE :: dv_prof_cas(:) REAL, ALLOCATABLE :: uw_prof_cas(:) REAL, ALLOCATABLE :: vw_prof_cas(:) REAL, ALLOCATABLE :: q1_prof_cas(:) REAL, ALLOCATABLE :: q2_prof_cas(:) REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ps_prof_cas, ustar_prof_cas, tke_prof_cas 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 CONTAINS SUBROUTINE read_1D_cas IMPLICIT NONE INTEGER nid, rid, ierr INTEGER ii, jj fich_cas = 'setup/cas.nc' PRINT*, 'fich_cas ', fich_cas ierr = nf90_open(fich_cas, nf90_nowrite, nid) PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid IF (ierr/=nf90_noerr) THEN WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file ' WRITE(*, *) nf90_strerror(ierr) stop "" endif !....................................................................... ierr = nf90_inq_dimid(nid, 'lat', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension lat' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = ii) PRINT*, 'OK1 nid,rid,lat', nid, rid, ii !....................................................................... ierr = nf90_inq_dimid(nid, 'lon', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension lon' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = jj) PRINT*, 'OK2 nid,rid,lat', nid, rid, jj !....................................................................... ierr = nf90_inq_dimid(nid, 'lev', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension zz' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas) PRINT*, 'OK3 nid,rid,nlev_cas', nid, rid, nlev_cas !....................................................................... ierr = nf90_inq_dimid(nid, 'time', rid) PRINT*, 'nid,rid', nid, rid nt_cas = 0 IF (ierr/=nf90_noerr) THEN stop 'probleme lecture dimension sens' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = nt_cas) PRINT*, 'OK4 nid,rid,nt_cas', nid, rid, nt_cas !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !profils moyens: allocate(plev_cas(nlev_cas, nt_cas)) allocate(z_cas(nlev_cas, nt_cas)) allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas)) allocate(th_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas)) allocate(u_cas(nlev_cas, nt_cas)) allocate(v_cas(nlev_cas, nt_cas)) !forcing 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)) allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas)) allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas)) allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas)) allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas)) allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas)) allocate(vitw_cas(nlev_cas, nt_cas)) allocate(ug_cas(nlev_cas, nt_cas)) allocate(vg_cas(nlev_cas, nt_cas)) allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ps_cas(nt_cas), ustar_cas(nt_cas)) 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)) !champs interpoles allocate(plev_prof_cas(nlev_cas)) allocate(t_prof_cas(nlev_cas)) allocate(q_prof_cas(nlev_cas)) allocate(u_prof_cas(nlev_cas)) allocate(v_prof_cas(nlev_cas)) allocate(vitw_prof_cas(nlev_cas)) allocate(ug_prof_cas(nlev_cas)) allocate(vg_prof_cas(nlev_cas)) allocate(ht_prof_cas(nlev_cas)) allocate(hq_prof_cas(nlev_cas)) allocate(hu_prof_cas(nlev_cas)) allocate(hv_prof_cas(nlev_cas)) allocate(vt_prof_cas(nlev_cas)) allocate(vq_prof_cas(nlev_cas)) allocate(vu_prof_cas(nlev_cas)) allocate(vv_prof_cas(nlev_cas)) allocate(dt_prof_cas(nlev_cas)) allocate(dtrad_prof_cas(nlev_cas)) allocate(dq_prof_cas(nlev_cas)) allocate(du_prof_cas(nlev_cas)) allocate(dv_prof_cas(nlev_cas)) allocate(uw_prof_cas(nlev_cas)) allocate(vw_prof_cas(nlev_cas)) allocate(q1_prof_cas(nlev_cas)) allocate(q2_prof_cas(nlev_cas)) PRINT*, 'Allocations OK' CALL read_cas2(nid, nlev_cas, nt_cas & , z_cas, plev_cas, t_cas, q_cas, rh_cas, th_cas, rv_cas, u_cas, v_cas & , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas, dv_cas, hv_cas, vv_cas & , dt_cas, dtrad_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas & , dth_cas, hth_cas, vth_cas, dr_cas, hr_cas, vr_cas, sens_cas, lat_cas, ts_cas& , ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas) PRINT*, 'Read cas OK' END SUBROUTINE read_1D_cas !********************************************************************************************** SUBROUTINE read2_1D_cas IMPLICIT NONE INTEGER nid, rid, ierr INTEGER ii, jj fich_cas = 'setup/cas.nc' PRINT*, 'fich_cas ', fich_cas ierr = nf90_open(fich_cas, nf90_nowrite, nid) PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid IF (ierr/=nf90_noerr) THEN WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file ' WRITE(*, *) nf90_strerror(ierr) stop "" endif !....................................................................... ierr = nf90_inq_dimid(nid, 'lat', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension lat' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = ii) PRINT*, 'OK1 read2: nid,rid,lat', nid, rid, ii !....................................................................... ierr = nf90_inq_dimid(nid, 'lon', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension lon' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = jj) PRINT*, 'OK2 read2: nid,rid,lat', nid, rid, jj !....................................................................... ierr = nf90_inq_dimid(nid, 'nlev', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension nlev' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas) PRINT*, 'OK3 read2: nid,rid,nlev_cas', nid, rid, nlev_cas !....................................................................... ierr = nf90_inq_dimid(nid, 'time', rid) nt_cas = 0 IF (ierr/=nf90_noerr) THEN stop 'Oh probleme lecture dimension time' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = nt_cas) PRINT*, 'OK4 read2: nid,rid,nt_cas', nid, rid, nt_cas !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !profils moyens: allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1)) allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1)) allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1)) 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), & qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas)) 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)) 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)) !forcing 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)) allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas)) allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas)) allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas)) allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas)) allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas)) allocate(ug_cas(nlev_cas, nt_cas)) allocate(vg_cas(nlev_cas, nt_cas)) 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)) 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)) !champs interpoles allocate(plev_prof_cas(nlev_cas)) allocate(t_prof_cas(nlev_cas)) allocate(theta_prof_cas(nlev_cas)) allocate(thl_prof_cas(nlev_cas)) allocate(thv_prof_cas(nlev_cas)) allocate(q_prof_cas(nlev_cas)) allocate(qv_prof_cas(nlev_cas)) allocate(ql_prof_cas(nlev_cas)) allocate(qi_prof_cas(nlev_cas)) allocate(rh_prof_cas(nlev_cas)) allocate(rv_prof_cas(nlev_cas)) allocate(u_prof_cas(nlev_cas)) allocate(v_prof_cas(nlev_cas)) allocate(vitw_prof_cas(nlev_cas)) allocate(omega_prof_cas(nlev_cas)) allocate(ug_prof_cas(nlev_cas)) allocate(vg_prof_cas(nlev_cas)) allocate(ht_prof_cas(nlev_cas)) allocate(hth_prof_cas(nlev_cas)) allocate(hq_prof_cas(nlev_cas)) allocate(hu_prof_cas(nlev_cas)) allocate(hv_prof_cas(nlev_cas)) allocate(vt_prof_cas(nlev_cas)) allocate(vth_prof_cas(nlev_cas)) allocate(vq_prof_cas(nlev_cas)) allocate(vu_prof_cas(nlev_cas)) allocate(vv_prof_cas(nlev_cas)) allocate(dt_prof_cas(nlev_cas)) allocate(dth_prof_cas(nlev_cas)) allocate(dtrad_prof_cas(nlev_cas)) allocate(dq_prof_cas(nlev_cas)) allocate(du_prof_cas(nlev_cas)) allocate(dv_prof_cas(nlev_cas)) allocate(uw_prof_cas(nlev_cas)) allocate(vw_prof_cas(nlev_cas)) allocate(q1_prof_cas(nlev_cas)) allocate(q2_prof_cas(nlev_cas)) PRINT*, 'Allocations OK' CALL read2_cas (nid, nlev_cas, nt_cas, & ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, & 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, & dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, & dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, ps_cas, ustar_cas, tke_cas, & uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, & o3_cas, rugos_cas, clay_cas, sand_cas) PRINT*, 'Read2 cas OK' DO ii = 1, nlev_cas PRINT*, 'apres read2_cas, plev_cas=', ii, plev_cas(ii, 1) enddo END SUBROUTINE read2_1D_cas !********************************************************************************************** SUBROUTINE old_read_SCM_cas USE netcdf, ONLY: nf90_get_var USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas IMPLICIT NONE INTEGER nid, rid, ierr INTEGER ii, jj, timeid REAL, ALLOCATABLE :: time_val(:) fich_cas = 'cas.nc' PRINT*, 'fich_cas ', fich_cas ierr = nf90_open(fich_cas, nf90_nowrite, nid) PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid IF (ierr/=nf90_noerr) THEN WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file ' WRITE(*, *) nf90_strerror(ierr) stop "" endif !....................................................................... ierr = nf90_inq_dimid(nid, 'lat', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension lat' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = ii) PRINT*, 'OK1 read2: nid,rid,lat', nid, rid, ii !....................................................................... ierr = nf90_inq_dimid(nid, 'lon', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension lon' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = jj) PRINT*, 'OK2 read2: nid,rid,lat', nid, rid, jj !....................................................................... ierr = nf90_inq_dimid(nid, 'lev', rid) IF (ierr/=nf90_noerr) THEN PRINT*, 'Oh probleme lecture dimension nlev' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas) PRINT*, 'OK3 read2: nid,rid,nlev_cas', nid, rid, nlev_cas IF (.NOT. (nlev_cas > 10 .AND. nlev_cas < 1000)) THEN PRINT*, 'Valeur de nlev_cas peu probable' STOP ENDIF !....................................................................... ierr = nf90_inq_dimid(nid, 'time', rid) nt_cas = 0 IF (ierr/=nf90_noerr) THEN stop 'Oh probleme lecture dimension time' ENDIF ierr = nf90_inquire_dimension(nid, rid, len = nt_cas) PRINT*, 'OK4 read2: nid,rid,nt_cas', nid, rid, nt_cas ! Lecture de l'axe des temps PRINT*, 'LECTURE DU TEMPS' ierr = nf90_inq_varid(nid, 'time', timeid) IF(ierr/=nf90_noerr) THEN PRINT *, 'Variable time manquante dans cas.nc:' ierr = nf90_noerr else allocate(time_val(nt_cas)) ierr = nf90_get_var(nid, timeid, time_val) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de time cas.nc: ' endif endif IF (nt_cas>1) THEN pdt_cas = time_val(2) - time_val(1) ELSE pdt_cas = 0. ENDIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !profils moyens: allocate(plev_cas(nlev_cas, nt_cas), plevh_cas(nlev_cas + 1)) allocate(z_cas(nlev_cas, nt_cas), zh_cas(nlev_cas + 1)) allocate(ap_cas(nlev_cas + 1), bp_cas(nlev_cas + 1)) 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), & qi_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas)) 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)) 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)) !forcing 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)) allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas)) allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas)) allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas)) allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas)) allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas)) allocate(ug_cas(nlev_cas, nt_cas)) allocate(vg_cas(nlev_cas, nt_cas)) 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)) 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)) !champs interpoles allocate(plev_prof_cas(nlev_cas)) allocate(t_prof_cas(nlev_cas)) allocate(theta_prof_cas(nlev_cas)) allocate(thl_prof_cas(nlev_cas)) allocate(thv_prof_cas(nlev_cas)) allocate(q_prof_cas(nlev_cas)) allocate(qv_prof_cas(nlev_cas)) allocate(ql_prof_cas(nlev_cas)) allocate(qi_prof_cas(nlev_cas)) allocate(rh_prof_cas(nlev_cas)) allocate(rv_prof_cas(nlev_cas)) allocate(u_prof_cas(nlev_cas)) allocate(v_prof_cas(nlev_cas)) allocate(vitw_prof_cas(nlev_cas)) allocate(omega_prof_cas(nlev_cas)) allocate(ug_prof_cas(nlev_cas)) allocate(vg_prof_cas(nlev_cas)) allocate(ht_prof_cas(nlev_cas)) allocate(hth_prof_cas(nlev_cas)) allocate(hq_prof_cas(nlev_cas)) allocate(hu_prof_cas(nlev_cas)) allocate(hv_prof_cas(nlev_cas)) allocate(vt_prof_cas(nlev_cas)) allocate(vth_prof_cas(nlev_cas)) allocate(vq_prof_cas(nlev_cas)) allocate(vu_prof_cas(nlev_cas)) allocate(vv_prof_cas(nlev_cas)) allocate(dt_prof_cas(nlev_cas)) allocate(dth_prof_cas(nlev_cas)) allocate(dtrad_prof_cas(nlev_cas)) allocate(dq_prof_cas(nlev_cas)) allocate(du_prof_cas(nlev_cas)) allocate(dv_prof_cas(nlev_cas)) allocate(uw_prof_cas(nlev_cas)) allocate(vw_prof_cas(nlev_cas)) allocate(q1_prof_cas(nlev_cas)) allocate(q2_prof_cas(nlev_cas)) PRINT*, 'Allocations OK' CALL old_read_SCM (nid, nlev_cas, nt_cas, & ap_cas, bp_cas, z_cas, plev_cas, zh_cas, plevh_cas, t_cas, th_cas, thv_cas, thl_cas, qv_cas, & 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, & dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas, & dr_cas, hr_cas, vr_cas, dtrad_cas, sens_cas, lat_cas, ts_cas, ps_cas, ustar_cas, tke_cas, & uw_cas, vw_cas, q1_cas, q2_cas, orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, heat_rough, & o3_cas, rugos_cas, clay_cas, sand_cas) PRINT*, 'Read2 cas OK' DO ii = 1, nlev_cas PRINT*, 'apres read2_cas, plev_cas=', ii, plev_cas(ii, 1) enddo END SUBROUTINE old_read_SCM_cas !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE deallocate2_1D_cases !profils environnementaux: deallocate(plev_cas, plevh_cas) deallocate(z_cas, zh_cas) deallocate(ap_cas, bp_cas) deallocate(t_cas, q_cas, qv_cas, ql_cas, qi_cas, rh_cas) deallocate(th_cas, thl_cas, thv_cas, rv_cas) deallocate(u_cas, v_cas, vitw_cas, omega_cas) !forcing deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas) deallocate(hq_cas, vq_cas, dq_cas) deallocate(hth_cas, vth_cas, dth_cas) deallocate(hr_cas, vr_cas, dr_cas) deallocate(hu_cas, vu_cas, du_cas) deallocate(hv_cas, vv_cas, dv_cas) deallocate(ug_cas) deallocate(vg_cas) deallocate(lat_cas, sens_cas, ts_cas, ps_cas, ustar_cas, tke_cas, uw_cas, vw_cas, q1_cas, q2_cas) !champs interpoles deallocate(plev_prof_cas) deallocate(t_prof_cas) deallocate(theta_prof_cas) deallocate(thl_prof_cas) deallocate(thv_prof_cas) deallocate(q_prof_cas) deallocate(qv_prof_cas) deallocate(ql_prof_cas) deallocate(qi_prof_cas) deallocate(rh_prof_cas) deallocate(rv_prof_cas) deallocate(u_prof_cas) deallocate(v_prof_cas) deallocate(vitw_prof_cas) deallocate(omega_prof_cas) deallocate(ug_prof_cas) deallocate(vg_prof_cas) deallocate(ht_prof_cas) deallocate(hq_prof_cas) deallocate(hu_prof_cas) deallocate(hv_prof_cas) deallocate(vt_prof_cas) deallocate(vq_prof_cas) deallocate(vu_prof_cas) deallocate(vv_prof_cas) deallocate(dt_prof_cas) deallocate(dtrad_prof_cas) deallocate(dq_prof_cas) deallocate(du_prof_cas) deallocate(dv_prof_cas) deallocate(t_prof_cas) deallocate(u_prof_cas) deallocate(v_prof_cas) deallocate(uw_prof_cas) deallocate(vw_prof_cas) deallocate(q1_prof_cas) deallocate(q2_prof_cas) END SUBROUTINE deallocate2_1D_cases !===================================================================== SUBROUTINE read_cas2(nid, nlevel, ntime & , zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, & du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, & dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2) !program reading forcing of the case study USE netcdf, ONLY: nf90_get_var IMPLICIT NONE INTEGER ntime, nlevel REAL zz(nlevel, ntime) REAL pp(nlevel, ntime) REAL temp(nlevel, ntime), qv(nlevel, ntime), rh(nlevel, ntime) REAL theta(nlevel, ntime), rv(nlevel, ntime) REAL u(nlevel, ntime) REAL v(nlevel, ntime) REAL ug(nlevel, ntime) REAL vg(nlevel, ntime) REAL w(nlevel, ntime) REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime) REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime) REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime) REAL dtrad(nlevel, ntime) REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime) REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime) REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime) REAL flat(ntime), sens(ntime), ts(ntime), ustar(ntime) REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime), resul(nlevel, ntime), resul1(ntime) INTEGER nid, ierr, ierr1, ierr2, rid, i INTEGER nbvar3d parameter(nbvar3d = 39) INTEGER var3didin(nbvar3d) CHARACTER*5 name_var(1:nbvar3d) data name_var/'zz', 'pp', 'temp', 'qv', 'rh', 'theta', 'rv', 'u', 'v', 'ug', 'vg', 'w', 'advu', 'hu', 'vu', & 'advv', 'hv', 'vv', 'advT', 'hT', 'vT', 'advq', 'hq', 'vq', 'advth', 'hth', 'vth', 'advr', 'hr', 'vr', & 'radT', 'uw', 'vw', 'q1', 'q2', 'sens', 'flat', 'ts', 'ustar'/ DO i = 1, nbvar3d PRINT *, 'Dans read_cas2, on va lire ', nid, i, name_var(i) enddo DO i = 1, nbvar3d ierr = nf90_inq_varid(nid, name_var(i), var3didin(i)) PRINT *, 'ierr=', i, ierr, name_var(i), var3didin(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Variable manquante dans cas.nc:', name_var(i) endif enddo DO i = 1, nbvar3d PRINT *, 'Dans read_cas2, on va lire ', var3didin(i), name_var(i) IF(i<=35) THEN ierr = nf90_get_var(nid, var3didin(i), resul, count = [1, 1, nlevel, ntime]) PRINT *, 'Dans read_cas2, on a lu ', ierr, var3didin(i), name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif else PRINT *, 'Dans read_cas2, on a lu ', ierr, var3didin(i), name_var(i) ierr = nf90_get_var(nid, var3didin(i), resul1, count = [1, 1, ntime]) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif endif select case(i) case(1) ; zz = resul case(2) ; pp = resul case(3) ; temp = resul case(4) ; qv = resul case(5) ; rh = resul case(6) ; theta = resul case(7) ; rv = resul case(8) ; u = resul case(9) ; v = resul case(10) ; ug = resul case(11) ; vg = resul case(12) ; w = resul case(13) ; du = resul case(14) ; hu = resul case(15) ; vu = resul case(16) ; dv = resul case(17) ; hv = resul case(18) ; vv = resul case(19) ; dt = resul case(20) ; ht = resul case(21) ; vt = resul case(22) ; dq = resul case(23) ; hq = resul case(24) ; vq = resul case(25) ; dth = resul case(26) ; hth = resul case(27) ; vth = resul case(28) ; dr = resul case(29) ; hr = resul case(30) ; vr = resul case(31) ; dtrad = resul case(32) ; uw = resul case(33) ; vw = resul case(34) ; q1 = resul case(35) ; q2 = resul case(36) ; sens = resul1 case(37) ; flat = resul1 case(38) ; ts = resul1 case(39) ; ustar = resul1 end select enddo END SUBROUTINE read_cas2 !====================================================================== SUBROUTINE read2_cas(nid, nlevel, ntime, & ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, ug, vg, & du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, & dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, ps, ustar, tke, uw, vw, q1, q2, & orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, & heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas) !program reading forcing of the case study USE netcdf, ONLY: nf90_get_var IMPLICIT NONE INTEGER ntime, nlevel REAL ap(nlevel + 1), bp(nlevel + 1) REAL zz(nlevel, ntime), zzh(nlevel + 1) REAL pp(nlevel, ntime), pph(nlevel + 1) REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime) REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime) REAL u(nlevel, ntime), v(nlevel, ntime) REAL ug(nlevel, ntime), vg(nlevel, ntime) REAL vitw(nlevel, ntime), omega(nlevel, ntime) REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime) REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime) REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime) REAL dtrad(nlevel, ntime) REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime) REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime) REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime) REAL flat(ntime), sens(ntime), ustar(ntime) REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime) REAL ts(ntime), ps(ntime), tke(ntime) 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 REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3 INTEGER nid, ierr, ierr1, ierr2, rid, i INTEGER nbvar3d parameter(nbvar3d = 62) INTEGER var3didin(nbvar3d), missing_var(nbvar3d) CHARACTER*12 name_var(1:nbvar3d) data name_var/'coor_par_a', 'coor_par_b', 'height_h', 'pressure_h', & 'w', 'omega', 'ug', 'vg', 'uadv', 'uadvh', 'uadvv', 'vadv', 'vadvh', 'vadvv', 'tadv', 'tadvh', 'tadvv', & 'qadv', 'qadvh', 'qadvv', 'thadv', 'thadvh', 'thadvv', 'thladvh', 'radv', 'radvh', 'radvv', 'radcool', 'q1', 'q2', 'ustress', 'vstress', & 'rh', & 'height_f', 'pressure_f', 'temp', 'theta', 'thv', 'thl', 'qv', 'ql', 'qi', 'rv', 'u', 'v', & 'sfc_sens_flx', 'sfc_lat_flx', 'ts', 'ps', 'ustar', 'tke', & 'orog', 'albedo', 'emiss', 't_skin', 'q_skin', 'mom_rough', 'heat_rough', 'o3', 'rugos', 'clay', 'sand'/ DO i = 1, nbvar3d missing_var(i) = 0. enddo !----------------------------------------------------------------------- DO i = 1, nbvar3d ierr = nf90_inq_varid(nid, name_var(i), var3didin(i)) IF(ierr/=nf90_noerr) THEN PRINT *, 'Variable manquante dans cas.nc:', i, name_var(i) ierr = nf90_noerr missing_var(i) = 1 else !----------------------------------------------------------------------- IF(i<=4) then ! Lecture des coord pression en (nlevelp1,lat,lon) ierr = nf90_get_var(nid, var3didin(i), apbp, count = [1, 1, nlevel + 1]) PRINT *, 'read2_cas(apbp), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif !----------------------------------------------------------------------- else IF(i>4.AND.i<=45) then ! Lecture des variables en (time,nlevel,lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul, count = [1, 1, nlevel, ntime]) PRINT *, 'read2_cas(resul), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif !----------------------------------------------------------------------- ELSE IF (i>45.AND.i<=51) then ! Lecture des variables en (time,lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul2, count = [1, 1, ntime]) PRINT *, 'read2_cas(resul2), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif !----------------------------------------------------------------------- else ! Lecture des constantes (lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul3) PRINT *, 'read2_cas(resul3), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif endif endif !----------------------------------------------------------------------- select case(i) case(1) ; ap = apbp ! donnees indexees en nlevel+1 case(2) ; bp = apbp case(3) ; zzh = apbp case(4) ; pph = apbp case(5) ; vitw = resul ! donnees indexees en nlevel,time case(6) ; omega = resul case(7) ; ug = resul case(8) ; vg = resul case(9) ; du = resul case(10) ; hu = resul case(11) ; vu = resul case(12) ; dv = resul case(13) ; hv = resul case(14) ; vv = resul case(15) ; dt = resul case(16) ; ht = resul case(17) ; vt = resul case(18) ; dq = resul case(19) ; hq = resul case(20) ; vq = resul case(21) ; dth = resul case(22) ; hth = resul case(23) ; vth = resul case(24) ; hthl = resul case(25) ; dr = resul case(26) ; hr = resul case(27) ; vr = resul case(28) ; dtrad = resul case(29) ; q1 = resul case(30) ; q2 = resul case(31) ; uw = resul case(32) ; vw = resul case(33) ; rh = resul case(34) ; zz = resul ! donnees en time,nlevel pour profil initial case(35) ; pp = resul case(36) ; temp = resul case(37) ; theta = resul case(38) ; thv = resul case(39) ; thl = resul case(40) ; qv = resul case(41) ; ql = resul case(42) ; qi = resul case(43) ; rv = resul case(44) ; u = resul case(45) ; v = resul case(46) ; sens = resul2 ! donnees indexees en time case(47) ; flat = resul2 case(48) ; ts = resul2 case(49) ; ps = resul2 case(50) ; ustar = resul2 case(51) ; tke = resul2 case(52) ; orog_cas = resul3 ! constantes case(53) ; albedo_cas = resul3 case(54) ; emiss_cas = resul3 case(55) ; t_skin_cas = resul3 case(56) ; q_skin_cas = resul3 case(57) ; mom_rough = resul3 case(58) ; heat_rough = resul3 case(59) ; o3_cas = resul3 case(60) ; rugos_cas = resul3 case(61) ; clay_cas = resul3 case(62) ; sand_cas = resul3 end select resul = 0. resul1 = 0. resul2 = 0. resul3 = 0. enddo !----------------------------------------------------------------------- END SUBROUTINE read2_cas !====================================================================== SUBROUTINE old_read_SCM(nid, nlevel, ntime, & ap, bp, zz, pp, zzh, pph, temp, theta, thv, thl, qv, ql, qi, rh, rv, u, v, vitw, omega, ug, vg, & du, hu, vu, dv, hv, vv, dt, ht, vt, dq, hq, vq, & dth, hth, vth, dr, hr, vr, dtrad, sens, flat, ts, ps, ustar, tke, uw, vw, q1, q2, & orog_cas, albedo_cas, emiss_cas, t_skin_cas, q_skin_cas, mom_rough, & heat_rough, o3_cas, rugos_cas, clay_cas, sand_cas) !program reading forcing of the case study USE netcdf, ONLY: nf90_get_var IMPLICIT NONE INTEGER ntime, nlevel, k, t REAL ap(nlevel + 1), bp(nlevel + 1) REAL zz(nlevel, ntime), zzh(nlevel + 1) REAL pp(nlevel, ntime), pph(nlevel + 1) !profils initiaux REAL temp0(nlevel), qv0(nlevel), ql0(nlevel), qi0(nlevel), u0(nlevel), v0(nlevel), tke0(nlevel) REAL pp0(nlevel) REAL temp(nlevel, ntime), qv(nlevel, ntime), ql(nlevel, ntime), qi(nlevel, ntime), rh(nlevel, ntime) REAL theta(nlevel, ntime), thv(nlevel, ntime), thl(nlevel, ntime), rv(nlevel, ntime) REAL u(nlevel, ntime), v(nlevel, ntime), tke(nlevel, ntime) REAL ug(nlevel, ntime), vg(nlevel, ntime) REAL vitw(nlevel, ntime), omega(nlevel, ntime) REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime) REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime) REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime) REAL dtrad(nlevel, ntime) REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime) REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime), hthl(nlevel, ntime) REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime) REAL flat(ntime), sens(ntime), ustar(ntime) REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime) REAL ts(ntime), ps(ntime) 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 REAL apbp(nlevel + 1), resul(nlevel, ntime), resul1(nlevel), resul2(ntime), resul3 INTEGER nid, ierr, ierr1, ierr2, rid, i INTEGER nbvar3d parameter(nbvar3d = 70) INTEGER var3didin(nbvar3d), missing_var(nbvar3d) CHARACTER*13 name_var(1:nbvar3d) data name_var/'coor_par_a', 'coor_par_b', 'height_h', 'pressure_h', & 'temp', 'qv', 'ql', 'qi', 'u', 'v', 'tke', 'pressure', & 'w', 'omega', 'ug', 'vg', 'uadv', 'uadvh', 'uadvv', 'vadv', 'vadvh', 'vadvv', 'tadv', 'tadvh', 'tadvv', & 'qvadv', 'qvadvh', 'qvadvv', 'thadv', 'thadvh', 'thadvv', 'thladvh', 'radv', 'radvh', 'radvv', 'radcool', 'q1', 'q2', 'ustress', & 'vstress', 'rh', & 'height_f', 'pressure_forc', 'tempt', 'theta', 'thv', 'thl', 'qvt', 'qlt', 'qit', 'rv', 'ut', 'vt', 'tket', & 'sfc_sens_flx', 'sfc_lat_flx', 'ts', 'ps', 'ustar', & 'orog', 'albedo', 'emiss', 't_skin', 'q_skin', 'mom_rough', 'heat_rough', 'o3', 'rugos', 'clay', 'sand'/ DO i = 1, nbvar3d missing_var(i) = 0. enddo !----------------------------------------------------------------------- PRINT*, 'ON EST LA' DO i = 1, nbvar3d ierr = nf90_inq_varid(nid, name_var(i), var3didin(i)) IF(ierr/=nf90_noerr) THEN PRINT *, 'Variable manquante dans cas.nc:', i, name_var(i) ierr = nf90_noerr missing_var(i) = 1 else !----------------------------------------------------------------------- IF(i<=4) then ! Lecture des coord pression en (nlevelp1,lat,lon) ierr = nf90_get_var(nid, var3didin(i), apbp) PRINT *, 'read2_cas(apbp), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif !----------------------------------------------------------------------- else IF(i>4.AND.i<=12) then ! Lecture des variables en (time,nlevel,lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul1) PRINT *, 'read2_cas(resul1), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul1), maxval(resul1) !----------------------------------------------------------------------- else IF(i>12.AND.i<=54) then ! Lecture des variables en (time,nlevel,lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul) PRINT *, 'read2_cas(resul), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul), maxval(resul) !----------------------------------------------------------------------- ELSE IF (i>54.AND.i<=65) then ! Lecture des variables en (time,lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul2) PRINT *, 'read2_cas(resul2), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif PRINT*, 'Lecture de la variable #i ', i, name_var(i), minval(resul2), maxval(resul2) !----------------------------------------------------------------------- else ! Lecture des constantes (lat,lon) ierr = nf90_get_var(nid, var3didin(i), resul3) PRINT *, 'read2_cas(resul3), on a lu ', i, name_var(i) IF(ierr/=nf90_noerr) THEN PRINT *, 'Pb a la lecture de cas.nc: ', name_var(i) stop "getvarup" endif PRINT*, 'Lecture de la variable #i ', i, name_var(i), resul3 endif endif !----------------------------------------------------------------------- select case(i) !case(1) ; ap=apbp ! donnees indexees en nlevel+1 ! case(2) ; bp=apbp case(3) ; zzh = apbp case(4) ; pph = apbp case(5) ; temp0 = resul1 ! donnees initiales case(6) ; qv0 = resul1 case(7) ; ql0 = resul1 case(8) ; qi0 = resul1 case(9) ; u0 = resul1 case(10) ; v0 = resul1 case(11) ; tke0 = resul1 case(12) ; pp0 = resul1 case(13) ; vitw = resul ! donnees indexees en nlevel,time case(14) ; omega = resul case(15) ; ug = resul case(16) ; vg = resul case(17) ; du = resul case(18) ; hu = resul case(19) ; vu = resul case(20) ; dv = resul case(21) ; hv = resul case(22) ; vv = resul case(23) ; dt = resul case(24) ; ht = resul case(25) ; vt = resul case(26) ; dq = resul case(27) ; hq = resul case(28) ; vq = resul case(29) ; dth = resul case(30) ; hth = resul case(31) ; vth = resul case(32) ; hthl = resul case(33) ; dr = resul case(34) ; hr = resul case(35) ; vr = resul case(36) ; dtrad = resul case(37) ; q1 = resul case(38) ; q2 = resul case(39) ; uw = resul case(40) ; vw = resul case(41) ; rh = resul case(42) ; zz = resul ! donnees en time,nlevel pour profil initial case(43) ; pp = resul case(44) ; temp = resul case(45) ; theta = resul case(46) ; thv = resul case(47) ; thl = resul case(48) ; qv = resul case(49) ; ql = resul case(50) ; qi = resul case(51) ; rv = resul case(52) ; u = resul case(53) ; v = resul case(54) ; tke = resul case(55) ; sens = resul2 ! donnees indexees en time case(56) ; flat = resul2 case(57) ; ts = resul2 case(58) ; ps = resul2 case(59) ; ustar = resul2 case(60) ; orog_cas = resul3 ! constantes case(61) ; albedo_cas = resul3 case(62) ; emiss_cas = resul3 case(63) ; t_skin_cas = resul3 case(64) ; q_skin_cas = resul3 case(65) ; mom_rough = resul3 case(66) ; heat_rough = resul3 case(67) ; o3_cas = resul3 case(68) ; rugos_cas = resul3 case(69) ; clay_cas = resul3 case(70) ; sand_cas = resul3 end select resul = 0. resul1 = 0. resul2 = 0. resul3 = 0. enddo PRINT*, 'Lecture de la variable APRES ,sens ', minval(sens), maxval(sens) PRINT*, 'Lecture de la variable APRES ,flat ', minval(flat), maxval(flat) !CR:ATTENTION EN ATTENTE DE REGLER LA QUESTION DU PAS DE TEMPS INITIAL DO t = 1, ntime DO k = 1, nlevel temp(k, t) = temp0(k) qv(k, t) = qv0(k) ql(k, t) = ql0(k) qi(k, t) = qi0(k) u(k, t) = u0(k) v(k, t) = v0(k) tke(k, t) = tke0(k) enddo enddo !----------------------------------------------------------------------- END SUBROUTINE old_read_SCM !====================================================================== !====================================================================== SUBROUTINE interp_case_time2(day, day1, annee_ref & ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & , nt_cas, nlev_cas & , ts_cas, ps_cas, plev_cas, t_cas, q_cas, u_cas, v_cas & , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas & , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas & , dq_cas, hq_cas, vq_cas, lat_cas, sens_cas, ustar_cas & , uw_cas, vw_cas, q1_cas, q2_cas & , ts_prof_cas, plev_prof_cas, t_prof_cas, q_prof_cas & , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas & , vitw_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas & , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas & , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas & , hq_prof_cas, vq_prof_cas, lat_prof_cas, sens_prof_cas & , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas) USE lmdz_compar1d USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas IMPLICIT NONE !--------------------------------------------------------------------------------------- ! Time interpolation of a 2D field to the timestep corresponding to day ! day: current julian day (e.g. 717538.2) ! day1: first day of the simulation ! nt_cas: total nb of data in the forcing ! pdt_cas: total time interval (in sec) between 2 forcing data !--------------------------------------------------------------------------------------- ! inputs: INTEGER annee_ref INTEGER nt_cas, nlev_cas REAL day, day1, day_cas REAL ts_cas(nt_cas), ps_cas(nt_cas) REAL plev_cas(nlev_cas, nt_cas) REAL t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas) REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas) REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas) REAL vitw_cas(nlev_cas, nt_cas) REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas) REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas) REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas) REAL dtrad_cas(nlev_cas, nt_cas) REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas) REAL lat_cas(nt_cas) REAL sens_cas(nt_cas) REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas) REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas) ! outputs: REAL plev_prof_cas(nlev_cas) REAL t_prof_cas(nlev_cas), q_prof_cas(nlev_cas) REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas) REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas) REAL vitw_prof_cas(nlev_cas) REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas) REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas) REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas) REAL dtrad_prof_cas(nlev_cas) REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas) REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas) ! local: INTEGER it_cas1, it_cas2, k REAL timeit, time_cas1, time_cas2, frac PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas ! On teste si la date du cas AMMA est correcte. ! C est pour memoire car en fait les fichiers .def ! sont censes etre corrects. ! A supprimer a terme (MPL 20150623) ! if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN ! Check that initial day of the simulation consistent with AMMA case: ! if (annee_ref.NE.2006) THEN ! PRINT*,'Pour AMMA, annee_ref doit etre 2006' ! PRINT*,'Changer annee_ref dans run.def' ! stop ! endif ! if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN ! PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas ! PRINT*,'Changer dayref dans run.def' ! stop ! endif ! if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN ! PRINT*,'AMMA a fini le 11 juillet' ! PRINT*,'Changer dayref ou nday dans run.def' ! stop ! endif ! endif ! Determine timestep relative to the 1st day: ! timeit=(day-day1)*86400. ! if (annee_ref.EQ.1992) THEN ! timeit=(day-day_cas)*86400. ! else ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 ! endif timeit = (day - day_ju_ini_cas) * 86400 !PRINT *,'day=',day !PRINT *,'day_ju_ini_cas=',day_ju_ini_cas !PRINT *,'pdt_cas=',pdt_cas !PRINT *,'timeit=',timeit !PRINT *,'nt_cas=',nt_cas ! Determine the closest observation times: ! it_cas1=INT(timeit/pdt_cas)+1 ! it_cas2=it_cas1 + 1 ! time_cas1=(it_cas1-1)*pdt_cas ! time_cas2=(it_cas2-1)*pdt_cas it_cas1 = INT(timeit / pdt_cas) + 1 IF (it_cas1 == nt_cas) THEN it_cas2 = it_cas1 ELSE it_cas2 = it_cas1 + 1 ENDIF time_cas1 = (it_cas1 - 1) * pdt_cas time_cas2 = (it_cas2 - 1) * pdt_cas !PRINT *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2 IF (it_cas1 > nt_cas) THEN WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & , day, day_ju_ini_cas, it_cas1, it_cas2, timeit stop ENDIF ! time interpolation: IF (it_cas1 == it_cas2) THEN frac = 0. ELSE frac = (time_cas2 - timeit) / (time_cas2 - time_cas1) frac = max(frac, 0.0) ENDIF lat_prof_cas = lat_cas(it_cas2) & - frac * (lat_cas(it_cas2) - lat_cas(it_cas1)) sens_prof_cas = sens_cas(it_cas2) & - frac * (sens_cas(it_cas2) - sens_cas(it_cas1)) ts_prof_cas = ts_cas(it_cas2) & - frac * (ts_cas(it_cas2) - ts_cas(it_cas1)) ustar_prof_cas = ustar_cas(it_cas2) & - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1)) DO k = 1, nlev_cas plev_prof_cas(k) = plev_cas(k, it_cas2) & - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1)) t_prof_cas(k) = t_cas(k, it_cas2) & - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1)) q_prof_cas(k) = q_cas(k, it_cas2) & - frac * (q_cas(k, it_cas2) - q_cas(k, it_cas1)) u_prof_cas(k) = u_cas(k, it_cas2) & - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1)) v_prof_cas(k) = v_cas(k, it_cas2) & - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1)) ug_prof_cas(k) = ug_cas(k, it_cas2) & - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1)) vg_prof_cas(k) = vg_cas(k, it_cas2) & - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1)) vitw_prof_cas(k) = vitw_cas(k, it_cas2) & - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1)) du_prof_cas(k) = du_cas(k, it_cas2) & - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1)) hu_prof_cas(k) = hu_cas(k, it_cas2) & - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1)) vu_prof_cas(k) = vu_cas(k, it_cas2) & - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1)) dv_prof_cas(k) = dv_cas(k, it_cas2) & - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1)) hv_prof_cas(k) = hv_cas(k, it_cas2) & - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1)) vv_prof_cas(k) = vv_cas(k, it_cas2) & - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1)) dt_prof_cas(k) = dt_cas(k, it_cas2) & - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1)) ht_prof_cas(k) = ht_cas(k, it_cas2) & - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1)) vt_prof_cas(k) = vt_cas(k, it_cas2) & - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1)) dtrad_prof_cas(k) = dtrad_cas(k, it_cas2) & - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1)) dq_prof_cas(k) = dq_cas(k, it_cas2) & - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1)) hq_prof_cas(k) = hq_cas(k, it_cas2) & - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1)) vq_prof_cas(k) = vq_cas(k, it_cas2) & - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1)) uw_prof_cas(k) = uw_cas(k, it_cas2) & - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1)) vw_prof_cas(k) = vw_cas(k, it_cas2) & - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1)) q1_prof_cas(k) = q1_cas(k, it_cas2) & - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1)) q2_prof_cas(k) = q2_cas(k, it_cas2) & - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1)) enddo END SUBROUTINE interp_case_time2 !********************************************************************************************** SUBROUTINE interp2_case_time(day, day1, annee_ref & ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & , nt_cas, nlev_cas & , ts_cas, ps_cas, plev_cas, t_cas, theta_cas, thv_cas, thl_cas & , qv_cas, ql_cas, qi_cas, u_cas, v_cas & , ug_cas, vg_cas, vitw_cas, omega_cas, du_cas, hu_cas, vu_cas & , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas & , dq_cas, hq_cas, vq_cas, dth_cas, hth_cas, vth_cas & , lat_cas, sens_cas, ustar_cas & , uw_cas, vw_cas, q1_cas, q2_cas, tke_cas & , ts_prof_cas, plev_prof_cas, t_prof_cas, theta_prof_cas & , thv_prof_cas, thl_prof_cas, qv_prof_cas, ql_prof_cas, qi_prof_cas & , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas & , vitw_prof_cas, omega_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas & , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas & , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas & , hq_prof_cas, vq_prof_cas, dth_prof_cas, hth_prof_cas, vth_prof_cas & , lat_prof_cas, sens_prof_cas & , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas, tke_prof_cas) USE lmdz_compar1d USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas IMPLICIT NONE !--------------------------------------------------------------------------------------- ! Time interpolation of a 2D field to the timestep corresponding to day ! day: current julian day (e.g. 717538.2) ! day1: first day of the simulation ! nt_cas: total nb of data in the forcing ! pdt_cas: total time interval (in sec) between 2 forcing data !--------------------------------------------------------------------------------------- ! inputs: INTEGER annee_ref INTEGER nt_cas, nlev_cas REAL day, day1, day_cas REAL ts_cas(nt_cas), ps_cas(nt_cas) REAL plev_cas(nlev_cas, nt_cas) 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) REAL qv_cas(nlev_cas, nt_cas), ql_cas(nlev_cas, nt_cas), qi_cas(nlev_cas, nt_cas) REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas) REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas) REAL vitw_cas(nlev_cas, nt_cas), omega_cas(nlev_cas, nt_cas) REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas) REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas) REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas) REAL dth_cas(nlev_cas, nt_cas), hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas) REAL dtrad_cas(nlev_cas, nt_cas) REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas) REAL lat_cas(nt_cas), sens_cas(nt_cas), tke_cas(nt_cas) REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas) REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas) ! outputs: REAL plev_prof_cas(nlev_cas) REAL t_prof_cas(nlev_cas), theta_prof_cas(nlev_cas), thl_prof_cas(nlev_cas), thv_prof_cas(nlev_cas) REAL qv_prof_cas(nlev_cas), ql_prof_cas(nlev_cas), qi_prof_cas(nlev_cas) REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas) REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas) REAL vitw_prof_cas(nlev_cas), omega_prof_cas(nlev_cas) REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas) REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas) REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas) REAL dth_prof_cas(nlev_cas), hth_prof_cas(nlev_cas), vth_prof_cas(nlev_cas) REAL dtrad_prof_cas(nlev_cas) REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas) REAL lat_prof_cas, sens_prof_cas, tke_prof_cas, ts_prof_cas, ustar_prof_cas REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas) ! local: INTEGER it_cas1, it_cas2, k REAL timeit, time_cas1, time_cas2, frac PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas ! do k=1,nlev_cas ! PRINT*,'debut de interp2_case_time, plev_cas=',k,plev_cas(k,1) ! enddo ! On teste si la date du cas AMMA est correcte. ! C est pour memoire car en fait les fichiers .def ! sont censes etre corrects. ! A supprimer a terme (MPL 20150623) ! if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN ! Check that initial day of the simulation consistent with AMMA case: ! if (annee_ref.NE.2006) THEN ! PRINT*,'Pour AMMA, annee_ref doit etre 2006' ! PRINT*,'Changer annee_ref dans run.def' ! stop ! endif ! if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN ! PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas ! PRINT*,'Changer dayref dans run.def' ! stop ! endif ! if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN ! PRINT*,'AMMA a fini le 11 juillet' ! PRINT*,'Changer dayref ou nday dans run.def' ! stop ! endif ! endif ! Determine timestep relative to the 1st day: ! timeit=(day-day1)*86400. ! if (annee_ref.EQ.1992) THEN ! timeit=(day-day_cas)*86400. ! else ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 ! endif timeit = (day - day_ju_ini_cas) * 86400 !PRINT *,'day=',day !PRINT *,'day_ju_ini_cas=',day_ju_ini_cas !PRINT *,'pdt_cas=',pdt_cas !PRINT *,'timeit=',timeit !PRINT *,'nt_cas=',nt_cas ! Determine the closest observation times: ! it_cas1=INT(timeit/pdt_cas)+1 ! it_cas2=it_cas1 + 1 ! time_cas1=(it_cas1-1)*pdt_cas ! time_cas2=(it_cas2-1)*pdt_cas it_cas1 = INT(timeit / pdt_cas) + 1 IF (it_cas1 == nt_cas) THEN it_cas2 = it_cas1 ELSE it_cas2 = it_cas1 + 1 ENDIF time_cas1 = (it_cas1 - 1) * pdt_cas time_cas2 = (it_cas2 - 1) * pdt_cas !PRINT *,'timeit,pdt_cas,nt_cas=',timeit,pdt_cas,nt_cas !PRINT *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2 IF (it_cas1 > nt_cas) THEN WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & , day, day_ju_ini_cas, it_cas1, it_cas2, timeit stop ENDIF ! time interpolation: IF (it_cas1 == it_cas2) THEN frac = 0. ELSE frac = (time_cas2 - timeit) / (time_cas2 - time_cas1) frac = max(frac, 0.0) ENDIF lat_prof_cas = lat_cas(it_cas2) & - frac * (lat_cas(it_cas2) - lat_cas(it_cas1)) sens_prof_cas = sens_cas(it_cas2) & - frac * (sens_cas(it_cas2) - sens_cas(it_cas1)) tke_prof_cas = tke_cas(it_cas2) & - frac * (tke_cas(it_cas2) - tke_cas(it_cas1)) ts_prof_cas = ts_cas(it_cas2) & - frac * (ts_cas(it_cas2) - ts_cas(it_cas1)) ustar_prof_cas = ustar_cas(it_cas2) & - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1)) DO k = 1, nlev_cas plev_prof_cas(k) = plev_cas(k, it_cas2) & - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1)) t_prof_cas(k) = t_cas(k, it_cas2) & - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1)) !PRINT *,'k,frac,plev_cas1,plev_cas2=',k,frac,plev_cas(k,it_cas1),plev_cas(k,it_cas2) theta_prof_cas(k) = theta_cas(k, it_cas2) & - frac * (theta_cas(k, it_cas2) - theta_cas(k, it_cas1)) thv_prof_cas(k) = thv_cas(k, it_cas2) & - frac * (thv_cas(k, it_cas2) - thv_cas(k, it_cas1)) thl_prof_cas(k) = thl_cas(k, it_cas2) & - frac * (thl_cas(k, it_cas2) - thl_cas(k, it_cas1)) qv_prof_cas(k) = qv_cas(k, it_cas2) & - frac * (qv_cas(k, it_cas2) - qv_cas(k, it_cas1)) ql_prof_cas(k) = ql_cas(k, it_cas2) & - frac * (ql_cas(k, it_cas2) - ql_cas(k, it_cas1)) qi_prof_cas(k) = qi_cas(k, it_cas2) & - frac * (qi_cas(k, it_cas2) - qi_cas(k, it_cas1)) u_prof_cas(k) = u_cas(k, it_cas2) & - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1)) v_prof_cas(k) = v_cas(k, it_cas2) & - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1)) ug_prof_cas(k) = ug_cas(k, it_cas2) & - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1)) vg_prof_cas(k) = vg_cas(k, it_cas2) & - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1)) vitw_prof_cas(k) = vitw_cas(k, it_cas2) & - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1)) omega_prof_cas(k) = omega_cas(k, it_cas2) & - frac * (omega_cas(k, it_cas2) - omega_cas(k, it_cas1)) du_prof_cas(k) = du_cas(k, it_cas2) & - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1)) hu_prof_cas(k) = hu_cas(k, it_cas2) & - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1)) vu_prof_cas(k) = vu_cas(k, it_cas2) & - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1)) dv_prof_cas(k) = dv_cas(k, it_cas2) & - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1)) hv_prof_cas(k) = hv_cas(k, it_cas2) & - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1)) vv_prof_cas(k) = vv_cas(k, it_cas2) & - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1)) dt_prof_cas(k) = dt_cas(k, it_cas2) & - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1)) ht_prof_cas(k) = ht_cas(k, it_cas2) & - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1)) vt_prof_cas(k) = vt_cas(k, it_cas2) & - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1)) dth_prof_cas(k) = dth_cas(k, it_cas2) & - frac * (dth_cas(k, it_cas2) - dth_cas(k, it_cas1)) hth_prof_cas(k) = hth_cas(k, it_cas2) & - frac * (hth_cas(k, it_cas2) - hth_cas(k, it_cas1)) vth_prof_cas(k) = vth_cas(k, it_cas2) & - frac * (vth_cas(k, it_cas2) - vth_cas(k, it_cas1)) dtrad_prof_cas(k) = dtrad_cas(k, it_cas2) & - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1)) dq_prof_cas(k) = dq_cas(k, it_cas2) & - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1)) hq_prof_cas(k) = hq_cas(k, it_cas2) & - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1)) vq_prof_cas(k) = vq_cas(k, it_cas2) & - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1)) uw_prof_cas(k) = uw_cas(k, it_cas2) & - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1)) vw_prof_cas(k) = vw_cas(k, it_cas2) & - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1)) q1_prof_cas(k) = q1_cas(k, it_cas2) & - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1)) q2_prof_cas(k) = q2_cas(k, it_cas2) & - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1)) enddo END SUBROUTINE interp2_case_time !********************************************************************************************** END MODULE mod_1D_cases_read2