- Timestamp:
- Aug 2, 2024, 2:12:03 PM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90
r5135 r5158 1 1 MODULE mod_1D_cases_read 2 USE netcdf, ONLY: nf90_noerr,nf90_strerror,nf90_inq_varid,nf90_inquire_dimension,nf90_inq_dimid,& 3 nf90_nowrite,nf90_open,nf90_get_var 4 5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 6 !Declarations specifiques au cas standard 7 CHARACTER*80 :: fich_cas 8 ! Discr?tisation 9 INTEGER nlev_cas, nt_cas 10 11 12 ! integer year_ini_cas, day_ini_cas, mth_ini_cas 13 ! real heure_ini_cas 14 ! real day_ju_ini_cas ! Julian day of case first day 15 ! parameter (year_ini_cas=2011) 16 ! parameter (year_ini_cas=1969) 17 ! parameter (mth_ini_cas=10) 18 ! parameter (mth_ini_cas=6) 19 ! parameter (day_ini_cas=1) ! 10 = 10Juil2006 20 ! parameter (day_ini_cas=24) ! 24 = 24 juin 1969 21 ! parameter (heure_ini_cas=0.) !0h en secondes 22 ! real pdt_cas 23 ! parameter (pdt_cas=3.*3600) 24 25 !CR ATTENTION TEST AMMA 26 ! parameter (year_ini_cas=2006) 27 ! parameter (mth_ini_cas=7) 28 ! parameter (day_ini_cas=10) ! 10 = 10Juil2006 29 ! parameter (heure_ini_cas=0.) !0h en secondes 30 ! parameter (pdt_cas=1800.) 31 32 !profils environnementaux 33 REAL, ALLOCATABLE:: plev_cas(:,:) 34 35 REAL, ALLOCATABLE:: z_cas(:,:) 36 REAL, ALLOCATABLE:: t_cas(:,:),q_cas(:,:),rh_cas(:,:) 37 REAL, ALLOCATABLE:: th_cas(:,:),rv_cas(:,:) 38 REAL, ALLOCATABLE:: u_cas(:,:) 39 REAL, ALLOCATABLE:: v_cas(:,:) 40 41 !forcing 42 REAL, ALLOCATABLE:: ht_cas(:,:),vt_cas(:,:),dt_cas(:,:),dtrad_cas(:,:) 43 REAL, ALLOCATABLE:: hth_cas(:,:),vth_cas(:,:),dth_cas(:,:) 44 REAL, ALLOCATABLE:: hq_cas(:,:),vq_cas(:,:),dq_cas(:,:) 45 REAL, ALLOCATABLE:: hr_cas(:,:),vr_cas(:,:),dr_cas(:,:) 46 REAL, ALLOCATABLE:: hu_cas(:,:),vu_cas(:,:),du_cas(:,:) 47 REAL, ALLOCATABLE:: hv_cas(:,:),vv_cas(:,:),dv_cas(:,:) 48 REAL, ALLOCATABLE:: vitw_cas(:,:) 49 REAL, ALLOCATABLE:: ug_cas(:,:),vg_cas(:,:) 50 REAL, ALLOCATABLE:: lat_cas(:),sens_cas(:),ts_cas(:),ustar_cas(:) 51 REAL, ALLOCATABLE:: uw_cas(:,:),vw_cas(:,:),q1_cas(:,:),q2_cas(:,:) 52 53 !champs interpoles 54 REAL, ALLOCATABLE:: plev_prof_cas(:) 55 REAL, ALLOCATABLE:: t_prof_cas(:) 56 REAL, ALLOCATABLE:: q_prof_cas(:) 57 REAL, ALLOCATABLE:: u_prof_cas(:) 58 REAL, ALLOCATABLE:: v_prof_cas(:) 59 60 REAL, ALLOCATABLE:: vitw_prof_cas(:) 61 REAL, ALLOCATABLE:: ug_prof_cas(:) 62 REAL, ALLOCATABLE:: vg_prof_cas(:) 63 REAL, ALLOCATABLE:: ht_prof_cas(:) 64 REAL, ALLOCATABLE:: hq_prof_cas(:) 65 REAL, ALLOCATABLE:: vt_prof_cas(:) 66 REAL, ALLOCATABLE:: vq_prof_cas(:) 67 REAL, ALLOCATABLE:: dt_prof_cas(:) 68 REAL, ALLOCATABLE:: dtrad_prof_cas(:) 69 REAL, ALLOCATABLE:: dq_prof_cas(:) 70 REAL, ALLOCATABLE:: hu_prof_cas(:) 71 REAL, ALLOCATABLE:: hv_prof_cas(:) 72 REAL, ALLOCATABLE:: vu_prof_cas(:) 73 REAL, ALLOCATABLE:: vv_prof_cas(:) 74 REAL, ALLOCATABLE:: du_prof_cas(:) 75 REAL, ALLOCATABLE:: dv_prof_cas(:) 76 REAL, ALLOCATABLE:: uw_prof_cas(:) 77 REAL, ALLOCATABLE:: vw_prof_cas(:) 78 REAL, ALLOCATABLE:: q1_prof_cas(:) 79 REAL, ALLOCATABLE:: q2_prof_cas(:) 80 81 82 REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas 83 2 USE netcdf, ONLY: nf90_noerr, nf90_strerror, nf90_inq_varid, nf90_inquire_dimension, nf90_inq_dimid, & 3 nf90_nowrite, nf90_open, nf90_get_var 4 5 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 6 !Declarations specifiques au cas standard 7 CHARACTER*80 :: fich_cas 8 ! Discr?tisation 9 INTEGER nlev_cas, nt_cas 10 11 12 ! integer year_ini_cas, day_ini_cas, mth_ini_cas 13 ! real heure_ini_cas 14 ! real day_ju_ini_cas ! Julian day of case first day 15 ! parameter (year_ini_cas=2011) 16 ! parameter (year_ini_cas=1969) 17 ! parameter (mth_ini_cas=10) 18 ! parameter (mth_ini_cas=6) 19 ! parameter (day_ini_cas=1) ! 10 = 10Juil2006 20 ! parameter (day_ini_cas=24) ! 24 = 24 juin 1969 21 ! parameter (heure_ini_cas=0.) !0h en secondes 22 ! real pdt_cas 23 ! parameter (pdt_cas=3.*3600) 24 25 !CR ATTENTION TEST AMMA 26 ! parameter (year_ini_cas=2006) 27 ! parameter (mth_ini_cas=7) 28 ! parameter (day_ini_cas=10) ! 10 = 10Juil2006 29 ! parameter (heure_ini_cas=0.) !0h en secondes 30 ! parameter (pdt_cas=1800.) 31 32 !profils environnementaux 33 REAL, ALLOCATABLE :: plev_cas(:, :) 34 35 REAL, ALLOCATABLE :: z_cas(:, :) 36 REAL, ALLOCATABLE :: t_cas(:, :), q_cas(:, :), rh_cas(:, :) 37 REAL, ALLOCATABLE :: th_cas(:, :), rv_cas(:, :) 38 REAL, ALLOCATABLE :: u_cas(:, :) 39 REAL, ALLOCATABLE :: v_cas(:, :) 40 41 !forcing 42 REAL, ALLOCATABLE :: ht_cas(:, :), vt_cas(:, :), dt_cas(:, :), dtrad_cas(:, :) 43 REAL, ALLOCATABLE :: hth_cas(:, :), vth_cas(:, :), dth_cas(:, :) 44 REAL, ALLOCATABLE :: hq_cas(:, :), vq_cas(:, :), dq_cas(:, :) 45 REAL, ALLOCATABLE :: hr_cas(:, :), vr_cas(:, :), dr_cas(:, :) 46 REAL, ALLOCATABLE :: hu_cas(:, :), vu_cas(:, :), du_cas(:, :) 47 REAL, ALLOCATABLE :: hv_cas(:, :), vv_cas(:, :), dv_cas(:, :) 48 REAL, ALLOCATABLE :: vitw_cas(:, :) 49 REAL, ALLOCATABLE :: ug_cas(:, :), vg_cas(:, :) 50 REAL, ALLOCATABLE :: lat_cas(:), sens_cas(:), ts_cas(:), ustar_cas(:) 51 REAL, ALLOCATABLE :: uw_cas(:, :), vw_cas(:, :), q1_cas(:, :), q2_cas(:, :) 52 53 !champs interpoles 54 REAL, ALLOCATABLE :: plev_prof_cas(:) 55 REAL, ALLOCATABLE :: t_prof_cas(:) 56 REAL, ALLOCATABLE :: q_prof_cas(:) 57 REAL, ALLOCATABLE :: u_prof_cas(:) 58 REAL, ALLOCATABLE :: v_prof_cas(:) 59 60 REAL, ALLOCATABLE :: vitw_prof_cas(:) 61 REAL, ALLOCATABLE :: ug_prof_cas(:) 62 REAL, ALLOCATABLE :: vg_prof_cas(:) 63 REAL, ALLOCATABLE :: ht_prof_cas(:) 64 REAL, ALLOCATABLE :: hq_prof_cas(:) 65 REAL, ALLOCATABLE :: vt_prof_cas(:) 66 REAL, ALLOCATABLE :: vq_prof_cas(:) 67 REAL, ALLOCATABLE :: dt_prof_cas(:) 68 REAL, ALLOCATABLE :: dtrad_prof_cas(:) 69 REAL, ALLOCATABLE :: dq_prof_cas(:) 70 REAL, ALLOCATABLE :: hu_prof_cas(:) 71 REAL, ALLOCATABLE :: hv_prof_cas(:) 72 REAL, ALLOCATABLE :: vu_prof_cas(:) 73 REAL, ALLOCATABLE :: vv_prof_cas(:) 74 REAL, ALLOCATABLE :: du_prof_cas(:) 75 REAL, ALLOCATABLE :: dv_prof_cas(:) 76 REAL, ALLOCATABLE :: uw_prof_cas(:) 77 REAL, ALLOCATABLE :: vw_prof_cas(:) 78 REAL, ALLOCATABLE :: q1_prof_cas(:) 79 REAL, ALLOCATABLE :: q2_prof_cas(:) 80 81 REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas 84 82 85 83 86 84 CONTAINS 87 85 88 SUBROUTINE read_1D_cas 89 90 INTEGER nid,rid,ierr 91 INTEGER ii,jj 92 93 fich_cas='setup/cas.nc' 94 PRINT*,'fich_cas ',fich_cas 95 ierr = nf90_open(fich_cas,nf90_nowrite,nid) 96 PRINT*,'fich_cas,nf90_nowrite,nid ',fich_cas,nf90_nowrite,nid 97 IF (ierr/=nf90_noerr) THEN 98 WRITE(*,*) 'ERROR: GROS Pb opening forcings nc file ' 99 WRITE(*,*) nf90_strerror(ierr) 100 stop "" 101 endif 102 !....................................................................... 103 ierr=nf90_inq_dimid(nid,'lat',rid) 104 IF (ierr/=nf90_noerr) THEN 105 PRINT*, 'Oh probleme lecture dimension lat' 106 ENDIF 107 ierr=nf90_inquire_dimension(nid,rid,len=ii) 108 PRINT*,'OK1 nid,rid,lat',nid,rid,ii 109 !....................................................................... 110 ierr=nf90_inq_dimid(nid,'lon',rid) 111 IF (ierr/=nf90_noerr) THEN 112 PRINT*, 'Oh probleme lecture dimension lon' 113 ENDIF 114 ierr=nf90_inquire_dimension(nid,rid,len=jj) 115 PRINT*,'OK2 nid,rid,lat',nid,rid,jj 116 !....................................................................... 117 ierr=nf90_inq_dimid(nid,'lev',rid) 118 IF (ierr/=nf90_noerr) THEN 119 PRINT*, 'Oh probleme lecture dimension zz' 120 ENDIF 121 ierr=nf90_inquire_dimension(nid,rid,len=nlev_cas) 122 PRINT*,'OK3 nid,rid,nlev_cas',nid,rid,nlev_cas 123 !....................................................................... 124 ierr=nf90_inq_dimid(nid,'time',rid) 125 PRINT*,'nid,rid',nid,rid 126 nt_cas=0 127 IF (ierr/=nf90_noerr) THEN 128 stop 'probleme lecture dimension sens' 129 ENDIF 130 ierr=nf90_inquire_dimension(nid,rid,len=nt_cas) 131 PRINT*,'OK4 nid,rid,nt_cas',nid,rid,nt_cas 132 133 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 134 !profils moyens: 135 allocate(plev_cas(nlev_cas,nt_cas)) 136 allocate(z_cas(nlev_cas,nt_cas)) 137 allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas)) 138 allocate(th_cas(nlev_cas,nt_cas),rv_cas(nlev_cas,nt_cas)) 139 allocate(u_cas(nlev_cas,nt_cas)) 140 allocate(v_cas(nlev_cas,nt_cas)) 141 142 !forcing 143 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)) 144 allocate(hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas),dq_cas(nlev_cas,nt_cas)) 145 allocate(hth_cas(nlev_cas,nt_cas),vth_cas(nlev_cas,nt_cas),dth_cas(nlev_cas,nt_cas)) 146 allocate(hr_cas(nlev_cas,nt_cas),vr_cas(nlev_cas,nt_cas),dr_cas(nlev_cas,nt_cas)) 147 allocate(hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas),du_cas(nlev_cas,nt_cas)) 148 allocate(hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas),dv_cas(nlev_cas,nt_cas)) 149 allocate(vitw_cas(nlev_cas,nt_cas)) 150 allocate(ug_cas(nlev_cas,nt_cas)) 151 allocate(vg_cas(nlev_cas,nt_cas)) 152 allocate(lat_cas(nt_cas),sens_cas(nt_cas),ts_cas(nt_cas),ustar_cas(nt_cas)) 153 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)) 154 155 156 !champs interpoles 157 allocate(plev_prof_cas(nlev_cas)) 158 allocate(t_prof_cas(nlev_cas)) 159 allocate(q_prof_cas(nlev_cas)) 160 allocate(u_prof_cas(nlev_cas)) 161 allocate(v_prof_cas(nlev_cas)) 162 163 allocate(vitw_prof_cas(nlev_cas)) 164 allocate(ug_prof_cas(nlev_cas)) 165 allocate(vg_prof_cas(nlev_cas)) 166 allocate(ht_prof_cas(nlev_cas)) 167 allocate(hq_prof_cas(nlev_cas)) 168 allocate(hu_prof_cas(nlev_cas)) 169 allocate(hv_prof_cas(nlev_cas)) 170 allocate(vt_prof_cas(nlev_cas)) 171 allocate(vq_prof_cas(nlev_cas)) 172 allocate(vu_prof_cas(nlev_cas)) 173 allocate(vv_prof_cas(nlev_cas)) 174 allocate(dt_prof_cas(nlev_cas)) 175 allocate(dtrad_prof_cas(nlev_cas)) 176 allocate(dq_prof_cas(nlev_cas)) 177 allocate(du_prof_cas(nlev_cas)) 178 allocate(dv_prof_cas(nlev_cas)) 179 allocate(uw_prof_cas(nlev_cas)) 180 allocate(vw_prof_cas(nlev_cas)) 181 allocate(q1_prof_cas(nlev_cas)) 182 allocate(q2_prof_cas(nlev_cas)) 183 184 PRINT*,'Allocations OK' 185 CALL read_cas(nid,nlev_cas,nt_cas & 186 ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas & 187 ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas & 188 ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas & 189 ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas& 190 ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas) 191 PRINT*,'Read cas OK' 192 193 194 END SUBROUTINE read_1D_cas 195 196 197 198 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 199 SUBROUTINE deallocate_1D_cases 200 !profils environnementaux: 201 deallocate(plev_cas) 202 203 deallocate(z_cas) 204 deallocate(t_cas,q_cas,rh_cas) 205 deallocate(th_cas,rv_cas) 206 deallocate(u_cas) 207 deallocate(v_cas) 208 209 !forcing 210 deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas) 211 deallocate(hq_cas,vq_cas,dq_cas) 212 deallocate(hth_cas,vth_cas,dth_cas) 213 deallocate(hr_cas,vr_cas,dr_cas) 214 deallocate(hu_cas,vu_cas,du_cas) 215 deallocate(hv_cas,vv_cas,dv_cas) 216 deallocate(vitw_cas) 217 deallocate(ug_cas) 218 deallocate(vg_cas) 219 deallocate(lat_cas,sens_cas,ts_cas,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas) 220 221 !champs interpoles 222 deallocate(plev_prof_cas) 223 deallocate(t_prof_cas) 224 deallocate(q_prof_cas) 225 deallocate(u_prof_cas) 226 deallocate(v_prof_cas) 227 228 deallocate(vitw_prof_cas) 229 deallocate(ug_prof_cas) 230 deallocate(vg_prof_cas) 231 deallocate(ht_prof_cas) 232 deallocate(hq_prof_cas) 233 deallocate(hu_prof_cas) 234 deallocate(hv_prof_cas) 235 deallocate(vt_prof_cas) 236 deallocate(vq_prof_cas) 237 deallocate(vu_prof_cas) 238 deallocate(vv_prof_cas) 239 deallocate(dt_prof_cas) 240 deallocate(dtrad_prof_cas) 241 deallocate(dq_prof_cas) 242 deallocate(du_prof_cas) 243 deallocate(dv_prof_cas) 244 deallocate(t_prof_cas) 245 deallocate(q_prof_cas) 246 deallocate(u_prof_cas) 247 deallocate(v_prof_cas) 248 deallocate(uw_prof_cas) 249 deallocate(vw_prof_cas) 250 deallocate(q1_prof_cas) 251 deallocate(q2_prof_cas) 252 253 END SUBROUTINE deallocate_1D_cases 86 SUBROUTINE read_1D_cas 87 88 INTEGER nid, rid, ierr 89 INTEGER ii, jj 90 91 fich_cas = 'setup/cas.nc' 92 PRINT*, 'fich_cas ', fich_cas 93 ierr = nf90_open(fich_cas, nf90_nowrite, nid) 94 PRINT*, 'fich_cas,nf90_nowrite,nid ', fich_cas, nf90_nowrite, nid 95 IF (ierr/=nf90_noerr) THEN 96 WRITE(*, *) 'ERROR: GROS Pb opening forcings nc file ' 97 WRITE(*, *) nf90_strerror(ierr) 98 stop "" 99 endif 100 !....................................................................... 101 ierr = nf90_inq_dimid(nid, 'lat', rid) 102 IF (ierr/=nf90_noerr) THEN 103 PRINT*, 'Oh probleme lecture dimension lat' 104 ENDIF 105 ierr = nf90_inquire_dimension(nid, rid, len = ii) 106 PRINT*, 'OK1 nid,rid,lat', nid, rid, ii 107 !....................................................................... 108 ierr = nf90_inq_dimid(nid, 'lon', rid) 109 IF (ierr/=nf90_noerr) THEN 110 PRINT*, 'Oh probleme lecture dimension lon' 111 ENDIF 112 ierr = nf90_inquire_dimension(nid, rid, len = jj) 113 PRINT*, 'OK2 nid,rid,lat', nid, rid, jj 114 !....................................................................... 115 ierr = nf90_inq_dimid(nid, 'lev', rid) 116 IF (ierr/=nf90_noerr) THEN 117 PRINT*, 'Oh probleme lecture dimension zz' 118 ENDIF 119 ierr = nf90_inquire_dimension(nid, rid, len = nlev_cas) 120 PRINT*, 'OK3 nid,rid,nlev_cas', nid, rid, nlev_cas 121 !....................................................................... 122 ierr = nf90_inq_dimid(nid, 'time', rid) 123 PRINT*, 'nid,rid', nid, rid 124 nt_cas = 0 125 IF (ierr/=nf90_noerr) THEN 126 stop 'probleme lecture dimension sens' 127 ENDIF 128 ierr = nf90_inquire_dimension(nid, rid, len = nt_cas) 129 PRINT*, 'OK4 nid,rid,nt_cas', nid, rid, nt_cas 130 131 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 132 !profils moyens: 133 allocate(plev_cas(nlev_cas, nt_cas)) 134 allocate(z_cas(nlev_cas, nt_cas)) 135 allocate(t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas), rh_cas(nlev_cas, nt_cas)) 136 allocate(th_cas(nlev_cas, nt_cas), rv_cas(nlev_cas, nt_cas)) 137 allocate(u_cas(nlev_cas, nt_cas)) 138 allocate(v_cas(nlev_cas, nt_cas)) 139 140 !forcing 141 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)) 142 allocate(hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas), dq_cas(nlev_cas, nt_cas)) 143 allocate(hth_cas(nlev_cas, nt_cas), vth_cas(nlev_cas, nt_cas), dth_cas(nlev_cas, nt_cas)) 144 allocate(hr_cas(nlev_cas, nt_cas), vr_cas(nlev_cas, nt_cas), dr_cas(nlev_cas, nt_cas)) 145 allocate(hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas), du_cas(nlev_cas, nt_cas)) 146 allocate(hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas), dv_cas(nlev_cas, nt_cas)) 147 allocate(vitw_cas(nlev_cas, nt_cas)) 148 allocate(ug_cas(nlev_cas, nt_cas)) 149 allocate(vg_cas(nlev_cas, nt_cas)) 150 allocate(lat_cas(nt_cas), sens_cas(nt_cas), ts_cas(nt_cas), ustar_cas(nt_cas)) 151 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)) 152 153 154 !champs interpoles 155 allocate(plev_prof_cas(nlev_cas)) 156 allocate(t_prof_cas(nlev_cas)) 157 allocate(q_prof_cas(nlev_cas)) 158 allocate(u_prof_cas(nlev_cas)) 159 allocate(v_prof_cas(nlev_cas)) 160 161 allocate(vitw_prof_cas(nlev_cas)) 162 allocate(ug_prof_cas(nlev_cas)) 163 allocate(vg_prof_cas(nlev_cas)) 164 allocate(ht_prof_cas(nlev_cas)) 165 allocate(hq_prof_cas(nlev_cas)) 166 allocate(hu_prof_cas(nlev_cas)) 167 allocate(hv_prof_cas(nlev_cas)) 168 allocate(vt_prof_cas(nlev_cas)) 169 allocate(vq_prof_cas(nlev_cas)) 170 allocate(vu_prof_cas(nlev_cas)) 171 allocate(vv_prof_cas(nlev_cas)) 172 allocate(dt_prof_cas(nlev_cas)) 173 allocate(dtrad_prof_cas(nlev_cas)) 174 allocate(dq_prof_cas(nlev_cas)) 175 allocate(du_prof_cas(nlev_cas)) 176 allocate(dv_prof_cas(nlev_cas)) 177 allocate(uw_prof_cas(nlev_cas)) 178 allocate(vw_prof_cas(nlev_cas)) 179 allocate(q1_prof_cas(nlev_cas)) 180 allocate(q2_prof_cas(nlev_cas)) 181 182 PRINT*, 'Allocations OK' 183 CALL read_cas(nid, nlev_cas, nt_cas & 184 , z_cas, plev_cas, t_cas, q_cas, rh_cas, th_cas, rv_cas, u_cas, v_cas & 185 , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas, dv_cas, hv_cas, vv_cas & 186 , dt_cas, dtrad_cas, ht_cas, vt_cas, dq_cas, hq_cas, vq_cas & 187 , dth_cas, hth_cas, vth_cas, dr_cas, hr_cas, vr_cas, sens_cas, lat_cas, ts_cas& 188 , ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas) 189 PRINT*, 'Read cas OK' 190 191 END SUBROUTINE read_1D_cas 192 193 194 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 195 SUBROUTINE deallocate_1D_cases 196 !profils environnementaux: 197 deallocate(plev_cas) 198 199 deallocate(z_cas) 200 deallocate(t_cas, q_cas, rh_cas) 201 deallocate(th_cas, rv_cas) 202 deallocate(u_cas) 203 deallocate(v_cas) 204 205 !forcing 206 deallocate(ht_cas, vt_cas, dt_cas, dtrad_cas) 207 deallocate(hq_cas, vq_cas, dq_cas) 208 deallocate(hth_cas, vth_cas, dth_cas) 209 deallocate(hr_cas, vr_cas, dr_cas) 210 deallocate(hu_cas, vu_cas, du_cas) 211 deallocate(hv_cas, vv_cas, dv_cas) 212 deallocate(vitw_cas) 213 deallocate(ug_cas) 214 deallocate(vg_cas) 215 deallocate(lat_cas, sens_cas, ts_cas, ustar_cas, uw_cas, vw_cas, q1_cas, q2_cas) 216 217 !champs interpoles 218 deallocate(plev_prof_cas) 219 deallocate(t_prof_cas) 220 deallocate(q_prof_cas) 221 deallocate(u_prof_cas) 222 deallocate(v_prof_cas) 223 224 deallocate(vitw_prof_cas) 225 deallocate(ug_prof_cas) 226 deallocate(vg_prof_cas) 227 deallocate(ht_prof_cas) 228 deallocate(hq_prof_cas) 229 deallocate(hu_prof_cas) 230 deallocate(hv_prof_cas) 231 deallocate(vt_prof_cas) 232 deallocate(vq_prof_cas) 233 deallocate(vu_prof_cas) 234 deallocate(vv_prof_cas) 235 deallocate(dt_prof_cas) 236 deallocate(dtrad_prof_cas) 237 deallocate(dq_prof_cas) 238 deallocate(du_prof_cas) 239 deallocate(dv_prof_cas) 240 deallocate(t_prof_cas) 241 deallocate(q_prof_cas) 242 deallocate(u_prof_cas) 243 deallocate(v_prof_cas) 244 deallocate(uw_prof_cas) 245 deallocate(vw_prof_cas) 246 deallocate(q1_prof_cas) 247 deallocate(q2_prof_cas) 248 249 END SUBROUTINE deallocate_1D_cases 254 250 255 251 !===================================================================== 256 SUBROUTINE read_cas(nid,nlevel,ntime & 257 ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, & 258 du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, & 259 dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2) 260 261 !program reading forcing of the case study 262 263 INTEGER ntime,nlevel 264 265 REAL zz(nlevel,ntime) 266 REAL pp(nlevel,ntime) 267 REAL temp(nlevel,ntime),qv(nlevel,ntime),rh(nlevel,ntime) 268 REAL theta(nlevel,ntime),rv(nlevel,ntime) 269 REAL u(nlevel,ntime) 270 REAL v(nlevel,ntime) 271 REAL ug(nlevel,ntime) 272 REAL vg(nlevel,ntime) 273 REAL w(nlevel,ntime) 274 REAL du(nlevel,ntime),hu(nlevel,ntime),vu(nlevel,ntime) 275 REAL dv(nlevel,ntime),hv(nlevel,ntime),vv(nlevel,ntime) 276 REAL dt(nlevel,ntime),ht(nlevel,ntime),vt(nlevel,ntime) 277 REAL dtrad(nlevel,ntime) 278 REAL dq(nlevel,ntime),hq(nlevel,ntime),vq(nlevel,ntime) 279 REAL dth(nlevel,ntime),hth(nlevel,ntime),vth(nlevel,ntime) 280 REAL dr(nlevel,ntime),hr(nlevel,ntime),vr(nlevel,ntime) 281 REAL flat(ntime),sens(ntime),ts(ntime),ustar(ntime) 282 REAL uw(nlevel,ntime),vw(nlevel,ntime),q1(nlevel,ntime),q2(nlevel,ntime) 283 284 285 INTEGER nid, ierr,rid 286 INTEGER nbvar3d 287 parameter(nbvar3d=39) 288 INTEGER var3didin(nbvar3d) 289 290 ierr=nf90_inq_varid(nid,"zz",var3didin(1)) 291 IF(ierr/=nf90_noerr) THEN 292 WRITE(*,*) nf90_strerror(ierr) 293 stop 'lev' 294 endif 295 296 ierr=nf90_inq_varid(nid,"pp",var3didin(2)) 297 IF(ierr/=nf90_noerr) THEN 298 WRITE(*,*) nf90_strerror(ierr) 299 stop 'plev' 300 endif 301 302 303 ierr=nf90_inq_varid(nid,"temp",var3didin(3)) 304 IF(ierr/=nf90_noerr) THEN 305 WRITE(*,*) nf90_strerror(ierr) 306 stop 'temp' 307 endif 308 309 ierr=nf90_inq_varid(nid,"qv",var3didin(4)) 310 IF(ierr/=nf90_noerr) THEN 311 WRITE(*,*) nf90_strerror(ierr) 312 stop 'qv' 313 endif 314 315 ierr=nf90_inq_varid(nid,"rh",var3didin(5)) 316 IF(ierr/=nf90_noerr) THEN 317 WRITE(*,*) nf90_strerror(ierr) 318 stop 'rh' 319 endif 320 321 ierr=nf90_inq_varid(nid,"theta",var3didin(6)) 322 IF(ierr/=nf90_noerr) THEN 323 WRITE(*,*) nf90_strerror(ierr) 324 stop 'theta' 325 endif 326 327 ierr=nf90_inq_varid(nid,"rv",var3didin(7)) 328 IF(ierr/=nf90_noerr) THEN 329 WRITE(*,*) nf90_strerror(ierr) 330 stop 'rv' 331 endif 332 333 334 ierr=nf90_inq_varid(nid,"u",var3didin(8)) 335 IF(ierr/=nf90_noerr) THEN 336 WRITE(*,*) nf90_strerror(ierr) 337 stop 'u' 338 endif 339 340 ierr=nf90_inq_varid(nid,"v",var3didin(9)) 341 IF(ierr/=nf90_noerr) THEN 342 WRITE(*,*) nf90_strerror(ierr) 343 stop 'v' 344 endif 345 346 ierr=nf90_inq_varid(nid,"ug",var3didin(10)) 347 IF(ierr/=nf90_noerr) THEN 348 WRITE(*,*) nf90_strerror(ierr) 349 stop 'ug' 350 endif 351 352 ierr=nf90_inq_varid(nid,"vg",var3didin(11)) 353 IF(ierr/=nf90_noerr) THEN 354 WRITE(*,*) nf90_strerror(ierr) 355 stop 'vg' 356 endif 357 358 ierr=nf90_inq_varid(nid,"w",var3didin(12)) 359 IF(ierr/=nf90_noerr) THEN 360 WRITE(*,*) nf90_strerror(ierr) 361 stop 'w' 362 endif 363 364 ierr=nf90_inq_varid(nid,"advu",var3didin(13)) 365 IF(ierr/=nf90_noerr) THEN 366 WRITE(*,*) nf90_strerror(ierr) 367 stop 'advu' 368 endif 369 370 ierr=nf90_inq_varid(nid,"hu",var3didin(14)) 371 IF(ierr/=nf90_noerr) THEN 372 WRITE(*,*) nf90_strerror(ierr) 373 stop 'hu' 374 endif 375 376 ierr=nf90_inq_varid(nid,"vu",var3didin(15)) 377 IF(ierr/=nf90_noerr) THEN 378 WRITE(*,*) nf90_strerror(ierr) 379 stop 'vu' 380 endif 381 382 ierr=nf90_inq_varid(nid,"advv",var3didin(16)) 383 IF(ierr/=nf90_noerr) THEN 384 WRITE(*,*) nf90_strerror(ierr) 385 stop 'advv' 386 endif 387 388 ierr=nf90_inq_varid(nid,"hv",var3didin(17)) 389 IF(ierr/=nf90_noerr) THEN 390 WRITE(*,*) nf90_strerror(ierr) 391 stop 'hv' 392 endif 393 394 ierr=nf90_inq_varid(nid,"vv",var3didin(18)) 395 IF(ierr/=nf90_noerr) THEN 396 WRITE(*,*) nf90_strerror(ierr) 397 stop 'vv' 398 endif 399 400 ierr=nf90_inq_varid(nid,"advT",var3didin(19)) 401 IF(ierr/=nf90_noerr) THEN 402 WRITE(*,*) nf90_strerror(ierr) 403 stop 'advT' 404 endif 405 406 ierr=nf90_inq_varid(nid,"hT",var3didin(20)) 407 IF(ierr/=nf90_noerr) THEN 408 WRITE(*,*) nf90_strerror(ierr) 409 stop 'hT' 410 endif 411 412 ierr=nf90_inq_varid(nid,"vT",var3didin(21)) 413 IF(ierr/=nf90_noerr) THEN 414 WRITE(*,*) nf90_strerror(ierr) 415 stop 'vT' 416 endif 417 418 ierr=nf90_inq_varid(nid,"advq",var3didin(22)) 419 IF(ierr/=nf90_noerr) THEN 420 WRITE(*,*) nf90_strerror(ierr) 421 stop 'advq' 422 endif 423 424 ierr=nf90_inq_varid(nid,"hq",var3didin(23)) 425 IF(ierr/=nf90_noerr) THEN 426 WRITE(*,*) nf90_strerror(ierr) 427 stop 'hq' 428 endif 429 430 ierr=nf90_inq_varid(nid,"vq",var3didin(24)) 431 IF(ierr/=nf90_noerr) THEN 432 WRITE(*,*) nf90_strerror(ierr) 433 stop 'vq' 434 endif 435 436 ierr=nf90_inq_varid(nid,"advth",var3didin(25)) 437 IF(ierr/=nf90_noerr) THEN 438 WRITE(*,*) nf90_strerror(ierr) 439 stop 'advth' 440 endif 441 442 ierr=nf90_inq_varid(nid,"hth",var3didin(26)) 443 IF(ierr/=nf90_noerr) THEN 444 WRITE(*,*) nf90_strerror(ierr) 445 stop 'hth' 446 endif 447 448 ierr=nf90_inq_varid(nid,"vth",var3didin(27)) 449 IF(ierr/=nf90_noerr) THEN 450 WRITE(*,*) nf90_strerror(ierr) 451 stop 'vth' 452 endif 453 454 ierr=nf90_inq_varid(nid,"advr",var3didin(28)) 455 IF(ierr/=nf90_noerr) THEN 456 WRITE(*,*) nf90_strerror(ierr) 457 stop 'advr' 458 endif 459 460 ierr=nf90_inq_varid(nid,"hr",var3didin(29)) 461 IF(ierr/=nf90_noerr) THEN 462 WRITE(*,*) nf90_strerror(ierr) 463 stop 'hr' 464 endif 465 466 ierr=nf90_inq_varid(nid,"vr",var3didin(30)) 467 IF(ierr/=nf90_noerr) THEN 468 WRITE(*,*) nf90_strerror(ierr) 469 stop 'vr' 470 endif 471 472 ierr=nf90_inq_varid(nid,"radT",var3didin(31)) 473 IF(ierr/=nf90_noerr) THEN 474 WRITE(*,*) nf90_strerror(ierr) 475 stop 'radT' 476 endif 477 478 ierr=nf90_inq_varid(nid,"sens",var3didin(32)) 479 IF(ierr/=nf90_noerr) THEN 480 WRITE(*,*) nf90_strerror(ierr) 481 stop 'sens' 482 endif 483 484 ierr=nf90_inq_varid(nid,"flat",var3didin(33)) 485 IF(ierr/=nf90_noerr) THEN 486 WRITE(*,*) nf90_strerror(ierr) 487 stop 'flat' 488 endif 489 490 ierr=nf90_inq_varid(nid,"ts",var3didin(34)) 491 IF(ierr/=nf90_noerr) THEN 492 WRITE(*,*) nf90_strerror(ierr) 493 stop 'ts' 494 endif 495 496 ierr=nf90_inq_varid(nid,"ustar",var3didin(35)) 497 IF(ierr/=nf90_noerr) THEN 498 WRITE(*,*) nf90_strerror(ierr) 499 stop 'ustar' 500 endif 501 502 ierr=nf90_inq_varid(nid,"uw",var3didin(36)) 503 IF(ierr/=nf90_noerr) THEN 504 WRITE(*,*) nf90_strerror(ierr) 505 stop 'uw' 506 endif 507 508 ierr=nf90_inq_varid(nid,"vw",var3didin(37)) 509 IF(ierr/=nf90_noerr) THEN 510 WRITE(*,*) nf90_strerror(ierr) 511 stop 'vw' 512 endif 513 514 ierr=nf90_inq_varid(nid,"q1",var3didin(38)) 515 IF(ierr/=nf90_noerr) THEN 516 WRITE(*,*) nf90_strerror(ierr) 517 stop 'q1' 518 endif 519 520 ierr=nf90_inq_varid(nid,"q2",var3didin(39)) 521 IF(ierr/=nf90_noerr) THEN 522 WRITE(*,*) nf90_strerror(ierr) 523 stop 'q2' 524 endif 525 526 ierr = nf90_get_var(nid,var3didin(1),zz) 527 IF(ierr/=nf90_noerr) THEN 528 WRITE(*,*) nf90_strerror(ierr) 529 stop "getvarup" 530 endif 531 ! WRITE(*,*)'lecture z ok',zz 532 533 ierr = nf90_get_var(nid,var3didin(2),pp) 534 IF(ierr/=nf90_noerr) THEN 535 WRITE(*,*) nf90_strerror(ierr) 536 stop "getvarup" 537 endif 538 ! WRITE(*,*)'lecture pp ok',pp 539 540 541 ierr = nf90_get_var(nid,var3didin(3),temp) 542 IF(ierr/=nf90_noerr) THEN 543 WRITE(*,*) nf90_strerror(ierr) 544 stop "getvarup" 545 endif 546 ! WRITE(*,*)'lecture T ok',temp 547 548 ierr = nf90_get_var(nid,var3didin(4),qv) 549 IF(ierr/=nf90_noerr) THEN 550 WRITE(*,*) nf90_strerror(ierr) 551 stop "getvarup" 552 endif 553 ! WRITE(*,*)'lecture qv ok',qv 554 555 ierr = nf90_get_var(nid,var3didin(5),rh) 556 IF(ierr/=nf90_noerr) THEN 557 WRITE(*,*) nf90_strerror(ierr) 558 stop "getvarup" 559 endif 560 ! WRITE(*,*)'lecture rh ok',rh 561 562 ierr = nf90_get_var(nid,var3didin(6),theta) 563 IF(ierr/=nf90_noerr) THEN 564 WRITE(*,*) nf90_strerror(ierr) 565 stop "getvarup" 566 endif 567 ! WRITE(*,*)'lecture theta ok',theta 568 569 ierr = nf90_get_var(nid,var3didin(7),rv) 570 IF(ierr/=nf90_noerr) THEN 571 WRITE(*,*) nf90_strerror(ierr) 572 stop "getvarup" 573 endif 574 ! WRITE(*,*)'lecture rv ok',rv 575 576 ierr = nf90_get_var(nid,var3didin(8),u) 577 IF(ierr/=nf90_noerr) THEN 578 WRITE(*,*) nf90_strerror(ierr) 579 stop "getvarup" 580 endif 581 ! WRITE(*,*)'lecture u ok',u 582 583 ierr = nf90_get_var(nid,var3didin(9),v) 584 IF(ierr/=nf90_noerr) THEN 585 WRITE(*,*) nf90_strerror(ierr) 586 stop "getvarup" 587 endif 588 ! WRITE(*,*)'lecture v ok',v 589 590 ierr = nf90_get_var(nid,var3didin(10),ug) 591 IF(ierr/=nf90_noerr) THEN 592 WRITE(*,*) nf90_strerror(ierr) 593 stop "getvarup" 594 endif 595 ! WRITE(*,*)'lecture ug ok',ug 596 597 ierr = nf90_get_var(nid,var3didin(11),vg) 598 IF(ierr/=nf90_noerr) THEN 599 WRITE(*,*) nf90_strerror(ierr) 600 stop "getvarup" 601 endif 602 ! WRITE(*,*)'lecture vg ok',vg 603 604 ierr = nf90_get_var(nid,var3didin(12),w) 605 IF(ierr/=nf90_noerr) THEN 606 WRITE(*,*) nf90_strerror(ierr) 607 stop "getvarup" 608 endif 609 ! WRITE(*,*)'lecture w ok',w 610 611 ierr = nf90_get_var(nid,var3didin(13),du) 612 IF(ierr/=nf90_noerr) THEN 613 WRITE(*,*) nf90_strerror(ierr) 614 stop "getvarup" 615 endif 616 ! WRITE(*,*)'lecture du ok',du 617 618 ierr = nf90_get_var(nid,var3didin(14),hu) 619 IF(ierr/=nf90_noerr) THEN 620 WRITE(*,*) nf90_strerror(ierr) 621 stop "getvarup" 622 endif 623 ! WRITE(*,*)'lecture hu ok',hu 624 625 ierr = nf90_get_var(nid,var3didin(15),vu) 626 IF(ierr/=nf90_noerr) THEN 627 WRITE(*,*) nf90_strerror(ierr) 628 stop "getvarup" 629 endif 630 ! WRITE(*,*)'lecture vu ok',vu 631 632 ierr = nf90_get_var(nid,var3didin(16),dv) 633 IF(ierr/=nf90_noerr) THEN 634 WRITE(*,*) nf90_strerror(ierr) 635 stop "getvarup" 636 endif 637 ! WRITE(*,*)'lecture dv ok',dv 638 639 ierr = nf90_get_var(nid,var3didin(17),hv) 640 IF(ierr/=nf90_noerr) THEN 641 WRITE(*,*) nf90_strerror(ierr) 642 stop "getvarup" 643 endif 644 ! WRITE(*,*)'lecture hv ok',hv 645 646 ierr = nf90_get_var(nid,var3didin(18),vv) 647 IF(ierr/=nf90_noerr) THEN 648 WRITE(*,*) nf90_strerror(ierr) 649 stop "getvarup" 650 endif 651 ! WRITE(*,*)'lecture vv ok',vv 652 653 ierr = nf90_get_var(nid,var3didin(19),dt) 654 IF(ierr/=nf90_noerr) THEN 655 WRITE(*,*) nf90_strerror(ierr) 656 stop "getvarup" 657 endif 658 ! WRITE(*,*)'lecture dt ok',dt 659 660 ierr = nf90_get_var(nid,var3didin(20),ht) 661 IF(ierr/=nf90_noerr) THEN 662 WRITE(*,*) nf90_strerror(ierr) 663 stop "getvarup" 664 endif 665 ! WRITE(*,*)'lecture ht ok',ht 666 667 ierr = nf90_get_var(nid,var3didin(21),vt) 668 IF(ierr/=nf90_noerr) THEN 669 WRITE(*,*) nf90_strerror(ierr) 670 stop "getvarup" 671 endif 672 ! WRITE(*,*)'lecture vt ok',vt 673 674 ierr = nf90_get_var(nid,var3didin(22),dq) 675 IF(ierr/=nf90_noerr) THEN 676 WRITE(*,*) nf90_strerror(ierr) 677 stop "getvarup" 678 endif 679 ! WRITE(*,*)'lecture dq ok',dq 680 681 ierr = nf90_get_var(nid,var3didin(23),hq) 682 IF(ierr/=nf90_noerr) THEN 683 WRITE(*,*) nf90_strerror(ierr) 684 stop "getvarup" 685 endif 686 ! WRITE(*,*)'lecture hq ok',hq 687 688 ierr = nf90_get_var(nid,var3didin(24),vq) 689 IF(ierr/=nf90_noerr) THEN 690 WRITE(*,*) nf90_strerror(ierr) 691 stop "getvarup" 692 endif 693 ! WRITE(*,*)'lecture vq ok',vq 694 695 ierr = nf90_get_var(nid,var3didin(25),dth) 696 IF(ierr/=nf90_noerr) THEN 697 WRITE(*,*) nf90_strerror(ierr) 698 stop "getvarup" 699 endif 700 ! WRITE(*,*)'lecture dth ok',dth 701 702 ierr = nf90_get_var(nid,var3didin(26),hth) 703 IF(ierr/=nf90_noerr) THEN 704 WRITE(*,*) nf90_strerror(ierr) 705 stop "getvarup" 706 endif 707 ! WRITE(*,*)'lecture hth ok',hth 708 709 ierr = nf90_get_var(nid,var3didin(27),vth) 710 IF(ierr/=nf90_noerr) THEN 711 WRITE(*,*) nf90_strerror(ierr) 712 stop "getvarup" 713 endif 714 ! WRITE(*,*)'lecture vth ok',vth 715 716 ierr = nf90_get_var(nid,var3didin(28),dr) 717 IF(ierr/=nf90_noerr) THEN 718 WRITE(*,*) nf90_strerror(ierr) 719 stop "getvarup" 720 endif 721 ! WRITE(*,*)'lecture dr ok',dr 722 723 ierr = nf90_get_var(nid,var3didin(29),hr) 724 IF(ierr/=nf90_noerr) THEN 725 WRITE(*,*) nf90_strerror(ierr) 726 stop "getvarup" 727 endif 728 ! WRITE(*,*)'lecture hr ok',hr 729 730 ierr = nf90_get_var(nid,var3didin(30),vr) 731 IF(ierr/=nf90_noerr) THEN 732 WRITE(*,*) nf90_strerror(ierr) 733 stop "getvarup" 734 endif 735 ! WRITE(*,*)'lecture vr ok',vr 736 737 ierr = nf90_get_var(nid,var3didin(31),dtrad) 738 IF(ierr/=nf90_noerr) THEN 739 WRITE(*,*) nf90_strerror(ierr) 740 stop "getvarup" 741 endif 742 ! WRITE(*,*)'lecture dtrad ok',dtrad 743 744 ierr = nf90_get_var(nid,var3didin(32),sens) 745 IF(ierr/=nf90_noerr) THEN 746 WRITE(*,*) nf90_strerror(ierr) 747 stop "getvarup" 748 endif 749 ! WRITE(*,*)'lecture sens ok',sens 750 751 ierr = nf90_get_var(nid,var3didin(33),flat) 752 IF(ierr/=nf90_noerr) THEN 753 WRITE(*,*) nf90_strerror(ierr) 754 stop "getvarup" 755 endif 756 ! WRITE(*,*)'lecture flat ok',flat 757 758 ierr = nf90_get_var(nid,var3didin(34),ts) 759 IF(ierr/=nf90_noerr) THEN 760 WRITE(*,*) nf90_strerror(ierr) 761 stop "getvarup" 762 endif 763 ! WRITE(*,*)'lecture ts ok',ts 764 765 ierr = nf90_get_var(nid,var3didin(35),ustar) 766 IF(ierr/=nf90_noerr) THEN 767 WRITE(*,*) nf90_strerror(ierr) 768 stop "getvarup" 769 endif 770 ! WRITE(*,*)'lecture ustar ok',ustar 771 772 ierr = nf90_get_var(nid,var3didin(36),uw) 773 IF(ierr/=nf90_noerr) THEN 774 WRITE(*,*) nf90_strerror(ierr) 775 stop "getvarup" 776 endif 777 ! WRITE(*,*)'lecture uw ok',uw 778 779 ierr = nf90_get_var(nid,var3didin(37),vw) 780 IF(ierr/=nf90_noerr) THEN 781 WRITE(*,*) nf90_strerror(ierr) 782 stop "getvarup" 783 endif 784 ! WRITE(*,*)'lecture vw ok',vw 785 786 ierr = nf90_get_var(nid,var3didin(38),q1) 787 IF(ierr/=nf90_noerr) THEN 788 WRITE(*,*) nf90_strerror(ierr) 789 stop "getvarup" 790 endif 791 ! WRITE(*,*)'lecture q1 ok',q1 792 793 ierr = nf90_get_var(nid,var3didin(39),q2) 794 IF(ierr/=nf90_noerr) THEN 795 WRITE(*,*) nf90_strerror(ierr) 796 stop "getvarup" 797 endif 798 ! WRITE(*,*)'lecture q2 ok',q2 799 800 801 802 END SUBROUTINE read_cas 803 !====================================================================== 804 SUBROUTINE interp_case_time(day,day1,annee_ref & 805 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 806 ,nt_cas,nlev_cas & 807 ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas & 808 ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas & 809 ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 810 ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas & 811 ,uw_cas,vw_cas,q1_cas,q2_cas & 812 ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas & 813 ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 814 ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 815 ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 816 ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 817 ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas & 818 ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas) 819 820 821 IMPLICIT NONE 822 823 !--------------------------------------------------------------------------------------- 824 ! Time interpolation of a 2D field to the timestep corresponding to day 825 826 ! day: current julian day (e.g. 717538.2) 827 ! day1: first day of the simulation 828 ! nt_cas: total nb of data in the forcing 829 ! pdt_cas: total time interval (in sec) between 2 forcing data 830 !--------------------------------------------------------------------------------------- 831 832 INCLUDE "compar1d.h" 833 INCLUDE "date_cas.h" 834 835 ! inputs: 836 INTEGER annee_ref 837 INTEGER nt_cas,nlev_cas 838 REAL day, day1,day_cas 839 REAL ts_cas(nt_cas) 840 REAL plev_cas(nlev_cas,nt_cas) 841 REAL t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas) 842 REAL u_cas(nlev_cas,nt_cas),v_cas(nlev_cas,nt_cas) 843 REAL ug_cas(nlev_cas,nt_cas),vg_cas(nlev_cas,nt_cas) 844 REAL vitw_cas(nlev_cas,nt_cas) 845 REAL du_cas(nlev_cas,nt_cas),hu_cas(nlev_cas,nt_cas),vu_cas(nlev_cas,nt_cas) 846 REAL dv_cas(nlev_cas,nt_cas),hv_cas(nlev_cas,nt_cas),vv_cas(nlev_cas,nt_cas) 847 REAL dt_cas(nlev_cas,nt_cas),ht_cas(nlev_cas,nt_cas),vt_cas(nlev_cas,nt_cas) 848 REAL dtrad_cas(nlev_cas,nt_cas) 849 REAL dq_cas(nlev_cas,nt_cas),hq_cas(nlev_cas,nt_cas),vq_cas(nlev_cas,nt_cas) 850 REAL lat_cas(nt_cas) 851 REAL sens_cas(nt_cas) 852 REAL ustar_cas(nt_cas),uw_cas(nlev_cas,nt_cas),vw_cas(nlev_cas,nt_cas) 853 REAL q1_cas(nlev_cas,nt_cas),q2_cas(nlev_cas,nt_cas) 854 855 ! outputs: 856 REAL plev_prof_cas(nlev_cas) 857 REAL t_prof_cas(nlev_cas),q_prof_cas(nlev_cas) 858 REAL u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 859 REAL ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas) 860 REAL vitw_prof_cas(nlev_cas) 861 REAL du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 862 REAL dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 863 REAL dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas) 864 REAL dtrad_prof_cas(nlev_cas) 865 REAL dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 866 REAL lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas 867 REAL uw_prof_cas(nlev_cas),vw_prof_cas(nlev_cas),q1_prof_cas(nlev_cas),q2_prof_cas(nlev_cas) 868 ! local: 869 INTEGER it_cas1, it_cas2,k 870 REAL timeit,time_cas1,time_cas2,frac 871 872 873 PRINT*,'Check time',day1,day_ju_ini_cas,day_deb+1,pdt_cas 874 875 ! On teste si la date du cas AMMA est correcte. 876 ! C est pour memoire car en fait les fichiers .def 877 ! sont censes etre corrects. 878 ! A supprimer a terme (MPL 20150623) 879 ! if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN 880 ! Check that initial day of the simulation consistent with AMMA case: 881 ! if (annee_ref.NE.2006) THEN 882 ! PRINT*,'Pour AMMA, annee_ref doit etre 2006' 883 ! PRINT*,'Changer annee_ref dans run.def' 884 ! stop 885 ! endif 886 ! if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN 887 ! PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas 888 ! PRINT*,'Changer dayref dans run.def' 889 ! stop 890 ! endif 891 ! if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN 892 ! PRINT*,'AMMA a fini le 11 juillet' 893 ! PRINT*,'Changer dayref ou nday dans run.def' 894 ! stop 895 ! endif 896 ! endif 897 898 ! Determine timestep relative to the 1st day: 899 ! timeit=(day-day1)*86400. 900 ! if (annee_ref.EQ.1992) THEN 901 ! timeit=(day-day_cas)*86400. 902 ! else 903 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 904 ! endif 905 timeit=(day-day_ju_ini_cas)*86400 906 print *,'day=',day 907 print *,'day_ju_ini_cas=',day_ju_ini_cas 908 print *,'pdt_cas=',pdt_cas 909 print *,'timeit=',timeit 910 print *,'nt_cas=',nt_cas 911 912 ! Determine the closest observation times: 913 ! it_cas1=INT(timeit/pdt_cas)+1 914 ! it_cas2=it_cas1 + 1 915 ! time_cas1=(it_cas1-1)*pdt_cas 916 ! time_cas2=(it_cas2-1)*pdt_cas 917 918 it_cas1=INT(timeit/pdt_cas)+1 919 IF (it_cas1 == nt_cas) THEN 920 it_cas2=it_cas1 921 ELSE 922 it_cas2=it_cas1 + 1 923 ENDIF 924 time_cas1=(it_cas1-1)*pdt_cas 925 time_cas2=(it_cas2-1)*pdt_cas 926 print *,'it_cas1=',it_cas1 927 print *,'it_cas2=',it_cas2 928 print *,'time_cas1=',time_cas1 929 print *,'time_cas2=',time_cas2 930 931 IF (it_cas1 > nt_cas) THEN 932 WRITE(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & 933 ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit 934 stop 935 endif 936 937 ! time interpolation: 938 IF (it_cas1 == it_cas2) THEN 939 frac=0. 940 ELSE 941 frac=(time_cas2-timeit)/(time_cas2-time_cas1) 942 frac=max(frac,0.0) 943 ENDIF 944 945 lat_prof_cas = lat_cas(it_cas2) & 946 -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 947 sens_prof_cas = sens_cas(it_cas2) & 948 -frac*(sens_cas(it_cas2)-sens_cas(it_cas1)) 949 ts_prof_cas = ts_cas(it_cas2) & 950 -frac*(ts_cas(it_cas2)-ts_cas(it_cas1)) 951 ustar_prof_cas = ustar_cas(it_cas2) & 952 -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1)) 953 954 do k=1,nlev_cas 955 plev_prof_cas(k) = plev_cas(k,it_cas2) & 956 -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1)) 957 t_prof_cas(k) = t_cas(k,it_cas2) & 958 -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1)) 959 q_prof_cas(k) = q_cas(k,it_cas2) & 960 -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1)) 961 u_prof_cas(k) = u_cas(k,it_cas2) & 962 -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1)) 963 v_prof_cas(k) = v_cas(k,it_cas2) & 964 -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1)) 965 ug_prof_cas(k) = ug_cas(k,it_cas2) & 966 -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1)) 967 vg_prof_cas(k) = vg_cas(k,it_cas2) & 968 -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1)) 969 vitw_prof_cas(k) = vitw_cas(k,it_cas2) & 970 -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1)) 971 du_prof_cas(k) = du_cas(k,it_cas2) & 972 -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1)) 973 hu_prof_cas(k) = hu_cas(k,it_cas2) & 974 -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1)) 975 vu_prof_cas(k) = vu_cas(k,it_cas2) & 976 -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1)) 977 dv_prof_cas(k) = dv_cas(k,it_cas2) & 978 -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1)) 979 hv_prof_cas(k) = hv_cas(k,it_cas2) & 980 -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1)) 981 vv_prof_cas(k) = vv_cas(k,it_cas2) & 982 -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1)) 983 dt_prof_cas(k) = dt_cas(k,it_cas2) & 984 -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1)) 985 ht_prof_cas(k) = ht_cas(k,it_cas2) & 986 -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1)) 987 vt_prof_cas(k) = vt_cas(k,it_cas2) & 988 -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1)) 989 dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) & 990 -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1)) 991 dq_prof_cas(k) = dq_cas(k,it_cas2) & 992 -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1)) 993 hq_prof_cas(k) = hq_cas(k,it_cas2) & 994 -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1)) 995 vq_prof_cas(k) = vq_cas(k,it_cas2) & 996 -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1)) 997 uw_prof_cas(k) = uw_cas(k,it_cas2) & 998 -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1)) 999 vw_prof_cas(k) = vw_cas(k,it_cas2) & 1000 -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1)) 1001 q1_prof_cas(k) = q1_cas(k,it_cas2) & 1002 -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1)) 1003 q2_prof_cas(k) = q2_cas(k,it_cas2) & 1004 -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1)) 1005 enddo 1006 1007 RETURN 1008 END 1009 1010 !********************************************************************************************** 252 SUBROUTINE read_cas(nid, nlevel, ntime & 253 , zz, pp, temp, qv, rh, theta, rv, u, v, ug, vg, w, & 254 du, hu, vu, dv, hv, vv, dt, dtrad, ht, vt, dq, hq, vq, & 255 dth, hth, vth, dr, hr, vr, sens, flat, ts, ustar, uw, vw, q1, q2) 256 257 !program reading forcing of the case study 258 259 INTEGER ntime, nlevel 260 261 REAL zz(nlevel, ntime) 262 REAL pp(nlevel, ntime) 263 REAL temp(nlevel, ntime), qv(nlevel, ntime), rh(nlevel, ntime) 264 REAL theta(nlevel, ntime), rv(nlevel, ntime) 265 REAL u(nlevel, ntime) 266 REAL v(nlevel, ntime) 267 REAL ug(nlevel, ntime) 268 REAL vg(nlevel, ntime) 269 REAL w(nlevel, ntime) 270 REAL du(nlevel, ntime), hu(nlevel, ntime), vu(nlevel, ntime) 271 REAL dv(nlevel, ntime), hv(nlevel, ntime), vv(nlevel, ntime) 272 REAL dt(nlevel, ntime), ht(nlevel, ntime), vt(nlevel, ntime) 273 REAL dtrad(nlevel, ntime) 274 REAL dq(nlevel, ntime), hq(nlevel, ntime), vq(nlevel, ntime) 275 REAL dth(nlevel, ntime), hth(nlevel, ntime), vth(nlevel, ntime) 276 REAL dr(nlevel, ntime), hr(nlevel, ntime), vr(nlevel, ntime) 277 REAL flat(ntime), sens(ntime), ts(ntime), ustar(ntime) 278 REAL uw(nlevel, ntime), vw(nlevel, ntime), q1(nlevel, ntime), q2(nlevel, ntime) 279 280 INTEGER nid, ierr, rid 281 INTEGER nbvar3d 282 parameter(nbvar3d = 39) 283 INTEGER var3didin(nbvar3d) 284 285 ierr = nf90_inq_varid(nid, "zz", var3didin(1)) 286 IF(ierr/=nf90_noerr) THEN 287 WRITE(*, *) nf90_strerror(ierr) 288 stop 'lev' 289 endif 290 291 ierr = nf90_inq_varid(nid, "pp", var3didin(2)) 292 IF(ierr/=nf90_noerr) THEN 293 WRITE(*, *) nf90_strerror(ierr) 294 stop 'plev' 295 endif 296 297 ierr = nf90_inq_varid(nid, "temp", var3didin(3)) 298 IF(ierr/=nf90_noerr) THEN 299 WRITE(*, *) nf90_strerror(ierr) 300 stop 'temp' 301 endif 302 303 ierr = nf90_inq_varid(nid, "qv", var3didin(4)) 304 IF(ierr/=nf90_noerr) THEN 305 WRITE(*, *) nf90_strerror(ierr) 306 stop 'qv' 307 endif 308 309 ierr = nf90_inq_varid(nid, "rh", var3didin(5)) 310 IF(ierr/=nf90_noerr) THEN 311 WRITE(*, *) nf90_strerror(ierr) 312 stop 'rh' 313 endif 314 315 ierr = nf90_inq_varid(nid, "theta", var3didin(6)) 316 IF(ierr/=nf90_noerr) THEN 317 WRITE(*, *) nf90_strerror(ierr) 318 stop 'theta' 319 endif 320 321 ierr = nf90_inq_varid(nid, "rv", var3didin(7)) 322 IF(ierr/=nf90_noerr) THEN 323 WRITE(*, *) nf90_strerror(ierr) 324 stop 'rv' 325 endif 326 327 ierr = nf90_inq_varid(nid, "u", var3didin(8)) 328 IF(ierr/=nf90_noerr) THEN 329 WRITE(*, *) nf90_strerror(ierr) 330 stop 'u' 331 endif 332 333 ierr = nf90_inq_varid(nid, "v", var3didin(9)) 334 IF(ierr/=nf90_noerr) THEN 335 WRITE(*, *) nf90_strerror(ierr) 336 stop 'v' 337 endif 338 339 ierr = nf90_inq_varid(nid, "ug", var3didin(10)) 340 IF(ierr/=nf90_noerr) THEN 341 WRITE(*, *) nf90_strerror(ierr) 342 stop 'ug' 343 endif 344 345 ierr = nf90_inq_varid(nid, "vg", var3didin(11)) 346 IF(ierr/=nf90_noerr) THEN 347 WRITE(*, *) nf90_strerror(ierr) 348 stop 'vg' 349 endif 350 351 ierr = nf90_inq_varid(nid, "w", var3didin(12)) 352 IF(ierr/=nf90_noerr) THEN 353 WRITE(*, *) nf90_strerror(ierr) 354 stop 'w' 355 endif 356 357 ierr = nf90_inq_varid(nid, "advu", var3didin(13)) 358 IF(ierr/=nf90_noerr) THEN 359 WRITE(*, *) nf90_strerror(ierr) 360 stop 'advu' 361 endif 362 363 ierr = nf90_inq_varid(nid, "hu", var3didin(14)) 364 IF(ierr/=nf90_noerr) THEN 365 WRITE(*, *) nf90_strerror(ierr) 366 stop 'hu' 367 endif 368 369 ierr = nf90_inq_varid(nid, "vu", var3didin(15)) 370 IF(ierr/=nf90_noerr) THEN 371 WRITE(*, *) nf90_strerror(ierr) 372 stop 'vu' 373 endif 374 375 ierr = nf90_inq_varid(nid, "advv", var3didin(16)) 376 IF(ierr/=nf90_noerr) THEN 377 WRITE(*, *) nf90_strerror(ierr) 378 stop 'advv' 379 endif 380 381 ierr = nf90_inq_varid(nid, "hv", var3didin(17)) 382 IF(ierr/=nf90_noerr) THEN 383 WRITE(*, *) nf90_strerror(ierr) 384 stop 'hv' 385 endif 386 387 ierr = nf90_inq_varid(nid, "vv", var3didin(18)) 388 IF(ierr/=nf90_noerr) THEN 389 WRITE(*, *) nf90_strerror(ierr) 390 stop 'vv' 391 endif 392 393 ierr = nf90_inq_varid(nid, "advT", var3didin(19)) 394 IF(ierr/=nf90_noerr) THEN 395 WRITE(*, *) nf90_strerror(ierr) 396 stop 'advT' 397 endif 398 399 ierr = nf90_inq_varid(nid, "hT", var3didin(20)) 400 IF(ierr/=nf90_noerr) THEN 401 WRITE(*, *) nf90_strerror(ierr) 402 stop 'hT' 403 endif 404 405 ierr = nf90_inq_varid(nid, "vT", var3didin(21)) 406 IF(ierr/=nf90_noerr) THEN 407 WRITE(*, *) nf90_strerror(ierr) 408 stop 'vT' 409 endif 410 411 ierr = nf90_inq_varid(nid, "advq", var3didin(22)) 412 IF(ierr/=nf90_noerr) THEN 413 WRITE(*, *) nf90_strerror(ierr) 414 stop 'advq' 415 endif 416 417 ierr = nf90_inq_varid(nid, "hq", var3didin(23)) 418 IF(ierr/=nf90_noerr) THEN 419 WRITE(*, *) nf90_strerror(ierr) 420 stop 'hq' 421 endif 422 423 ierr = nf90_inq_varid(nid, "vq", var3didin(24)) 424 IF(ierr/=nf90_noerr) THEN 425 WRITE(*, *) nf90_strerror(ierr) 426 stop 'vq' 427 endif 428 429 ierr = nf90_inq_varid(nid, "advth", var3didin(25)) 430 IF(ierr/=nf90_noerr) THEN 431 WRITE(*, *) nf90_strerror(ierr) 432 stop 'advth' 433 endif 434 435 ierr = nf90_inq_varid(nid, "hth", var3didin(26)) 436 IF(ierr/=nf90_noerr) THEN 437 WRITE(*, *) nf90_strerror(ierr) 438 stop 'hth' 439 endif 440 441 ierr = nf90_inq_varid(nid, "vth", var3didin(27)) 442 IF(ierr/=nf90_noerr) THEN 443 WRITE(*, *) nf90_strerror(ierr) 444 stop 'vth' 445 endif 446 447 ierr = nf90_inq_varid(nid, "advr", var3didin(28)) 448 IF(ierr/=nf90_noerr) THEN 449 WRITE(*, *) nf90_strerror(ierr) 450 stop 'advr' 451 endif 452 453 ierr = nf90_inq_varid(nid, "hr", var3didin(29)) 454 IF(ierr/=nf90_noerr) THEN 455 WRITE(*, *) nf90_strerror(ierr) 456 stop 'hr' 457 endif 458 459 ierr = nf90_inq_varid(nid, "vr", var3didin(30)) 460 IF(ierr/=nf90_noerr) THEN 461 WRITE(*, *) nf90_strerror(ierr) 462 stop 'vr' 463 endif 464 465 ierr = nf90_inq_varid(nid, "radT", var3didin(31)) 466 IF(ierr/=nf90_noerr) THEN 467 WRITE(*, *) nf90_strerror(ierr) 468 stop 'radT' 469 endif 470 471 ierr = nf90_inq_varid(nid, "sens", var3didin(32)) 472 IF(ierr/=nf90_noerr) THEN 473 WRITE(*, *) nf90_strerror(ierr) 474 stop 'sens' 475 endif 476 477 ierr = nf90_inq_varid(nid, "flat", var3didin(33)) 478 IF(ierr/=nf90_noerr) THEN 479 WRITE(*, *) nf90_strerror(ierr) 480 stop 'flat' 481 endif 482 483 ierr = nf90_inq_varid(nid, "ts", var3didin(34)) 484 IF(ierr/=nf90_noerr) THEN 485 WRITE(*, *) nf90_strerror(ierr) 486 stop 'ts' 487 endif 488 489 ierr = nf90_inq_varid(nid, "ustar", var3didin(35)) 490 IF(ierr/=nf90_noerr) THEN 491 WRITE(*, *) nf90_strerror(ierr) 492 stop 'ustar' 493 endif 494 495 ierr = nf90_inq_varid(nid, "uw", var3didin(36)) 496 IF(ierr/=nf90_noerr) THEN 497 WRITE(*, *) nf90_strerror(ierr) 498 stop 'uw' 499 endif 500 501 ierr = nf90_inq_varid(nid, "vw", var3didin(37)) 502 IF(ierr/=nf90_noerr) THEN 503 WRITE(*, *) nf90_strerror(ierr) 504 stop 'vw' 505 endif 506 507 ierr = nf90_inq_varid(nid, "q1", var3didin(38)) 508 IF(ierr/=nf90_noerr) THEN 509 WRITE(*, *) nf90_strerror(ierr) 510 stop 'q1' 511 endif 512 513 ierr = nf90_inq_varid(nid, "q2", var3didin(39)) 514 IF(ierr/=nf90_noerr) THEN 515 WRITE(*, *) nf90_strerror(ierr) 516 stop 'q2' 517 endif 518 519 ierr = nf90_get_var(nid, var3didin(1), zz) 520 IF(ierr/=nf90_noerr) THEN 521 WRITE(*, *) nf90_strerror(ierr) 522 stop "getvarup" 523 endif 524 ! WRITE(*,*)'lecture z ok',zz 525 526 ierr = nf90_get_var(nid, var3didin(2), pp) 527 IF(ierr/=nf90_noerr) THEN 528 WRITE(*, *) nf90_strerror(ierr) 529 stop "getvarup" 530 endif 531 ! WRITE(*,*)'lecture pp ok',pp 532 533 ierr = nf90_get_var(nid, var3didin(3), temp) 534 IF(ierr/=nf90_noerr) THEN 535 WRITE(*, *) nf90_strerror(ierr) 536 stop "getvarup" 537 endif 538 ! WRITE(*,*)'lecture T ok',temp 539 540 ierr = nf90_get_var(nid, var3didin(4), qv) 541 IF(ierr/=nf90_noerr) THEN 542 WRITE(*, *) nf90_strerror(ierr) 543 stop "getvarup" 544 endif 545 ! WRITE(*,*)'lecture qv ok',qv 546 547 ierr = nf90_get_var(nid, var3didin(5), rh) 548 IF(ierr/=nf90_noerr) THEN 549 WRITE(*, *) nf90_strerror(ierr) 550 stop "getvarup" 551 endif 552 ! WRITE(*,*)'lecture rh ok',rh 553 554 ierr = nf90_get_var(nid, var3didin(6), theta) 555 IF(ierr/=nf90_noerr) THEN 556 WRITE(*, *) nf90_strerror(ierr) 557 stop "getvarup" 558 endif 559 ! WRITE(*,*)'lecture theta ok',theta 560 561 ierr = nf90_get_var(nid, var3didin(7), rv) 562 IF(ierr/=nf90_noerr) THEN 563 WRITE(*, *) nf90_strerror(ierr) 564 stop "getvarup" 565 endif 566 ! WRITE(*,*)'lecture rv ok',rv 567 568 ierr = nf90_get_var(nid, var3didin(8), u) 569 IF(ierr/=nf90_noerr) THEN 570 WRITE(*, *) nf90_strerror(ierr) 571 stop "getvarup" 572 endif 573 ! WRITE(*,*)'lecture u ok',u 574 575 ierr = nf90_get_var(nid, var3didin(9), v) 576 IF(ierr/=nf90_noerr) THEN 577 WRITE(*, *) nf90_strerror(ierr) 578 stop "getvarup" 579 endif 580 ! WRITE(*,*)'lecture v ok',v 581 582 ierr = nf90_get_var(nid, var3didin(10), ug) 583 IF(ierr/=nf90_noerr) THEN 584 WRITE(*, *) nf90_strerror(ierr) 585 stop "getvarup" 586 endif 587 ! WRITE(*,*)'lecture ug ok',ug 588 589 ierr = nf90_get_var(nid, var3didin(11), vg) 590 IF(ierr/=nf90_noerr) THEN 591 WRITE(*, *) nf90_strerror(ierr) 592 stop "getvarup" 593 endif 594 ! WRITE(*,*)'lecture vg ok',vg 595 596 ierr = nf90_get_var(nid, var3didin(12), w) 597 IF(ierr/=nf90_noerr) THEN 598 WRITE(*, *) nf90_strerror(ierr) 599 stop "getvarup" 600 endif 601 ! WRITE(*,*)'lecture w ok',w 602 603 ierr = nf90_get_var(nid, var3didin(13), du) 604 IF(ierr/=nf90_noerr) THEN 605 WRITE(*, *) nf90_strerror(ierr) 606 stop "getvarup" 607 endif 608 ! WRITE(*,*)'lecture du ok',du 609 610 ierr = nf90_get_var(nid, var3didin(14), hu) 611 IF(ierr/=nf90_noerr) THEN 612 WRITE(*, *) nf90_strerror(ierr) 613 stop "getvarup" 614 endif 615 ! WRITE(*,*)'lecture hu ok',hu 616 617 ierr = nf90_get_var(nid, var3didin(15), vu) 618 IF(ierr/=nf90_noerr) THEN 619 WRITE(*, *) nf90_strerror(ierr) 620 stop "getvarup" 621 endif 622 ! WRITE(*,*)'lecture vu ok',vu 623 624 ierr = nf90_get_var(nid, var3didin(16), dv) 625 IF(ierr/=nf90_noerr) THEN 626 WRITE(*, *) nf90_strerror(ierr) 627 stop "getvarup" 628 endif 629 ! WRITE(*,*)'lecture dv ok',dv 630 631 ierr = nf90_get_var(nid, var3didin(17), hv) 632 IF(ierr/=nf90_noerr) THEN 633 WRITE(*, *) nf90_strerror(ierr) 634 stop "getvarup" 635 endif 636 ! WRITE(*,*)'lecture hv ok',hv 637 638 ierr = nf90_get_var(nid, var3didin(18), vv) 639 IF(ierr/=nf90_noerr) THEN 640 WRITE(*, *) nf90_strerror(ierr) 641 stop "getvarup" 642 endif 643 ! WRITE(*,*)'lecture vv ok',vv 644 645 ierr = nf90_get_var(nid, var3didin(19), dt) 646 IF(ierr/=nf90_noerr) THEN 647 WRITE(*, *) nf90_strerror(ierr) 648 stop "getvarup" 649 endif 650 ! WRITE(*,*)'lecture dt ok',dt 651 652 ierr = nf90_get_var(nid, var3didin(20), ht) 653 IF(ierr/=nf90_noerr) THEN 654 WRITE(*, *) nf90_strerror(ierr) 655 stop "getvarup" 656 endif 657 ! WRITE(*,*)'lecture ht ok',ht 658 659 ierr = nf90_get_var(nid, var3didin(21), vt) 660 IF(ierr/=nf90_noerr) THEN 661 WRITE(*, *) nf90_strerror(ierr) 662 stop "getvarup" 663 endif 664 ! WRITE(*,*)'lecture vt ok',vt 665 666 ierr = nf90_get_var(nid, var3didin(22), dq) 667 IF(ierr/=nf90_noerr) THEN 668 WRITE(*, *) nf90_strerror(ierr) 669 stop "getvarup" 670 endif 671 ! WRITE(*,*)'lecture dq ok',dq 672 673 ierr = nf90_get_var(nid, var3didin(23), hq) 674 IF(ierr/=nf90_noerr) THEN 675 WRITE(*, *) nf90_strerror(ierr) 676 stop "getvarup" 677 endif 678 ! WRITE(*,*)'lecture hq ok',hq 679 680 ierr = nf90_get_var(nid, var3didin(24), vq) 681 IF(ierr/=nf90_noerr) THEN 682 WRITE(*, *) nf90_strerror(ierr) 683 stop "getvarup" 684 endif 685 ! WRITE(*,*)'lecture vq ok',vq 686 687 ierr = nf90_get_var(nid, var3didin(25), dth) 688 IF(ierr/=nf90_noerr) THEN 689 WRITE(*, *) nf90_strerror(ierr) 690 stop "getvarup" 691 endif 692 ! WRITE(*,*)'lecture dth ok',dth 693 694 ierr = nf90_get_var(nid, var3didin(26), hth) 695 IF(ierr/=nf90_noerr) THEN 696 WRITE(*, *) nf90_strerror(ierr) 697 stop "getvarup" 698 endif 699 ! WRITE(*,*)'lecture hth ok',hth 700 701 ierr = nf90_get_var(nid, var3didin(27), vth) 702 IF(ierr/=nf90_noerr) THEN 703 WRITE(*, *) nf90_strerror(ierr) 704 stop "getvarup" 705 endif 706 ! WRITE(*,*)'lecture vth ok',vth 707 708 ierr = nf90_get_var(nid, var3didin(28), dr) 709 IF(ierr/=nf90_noerr) THEN 710 WRITE(*, *) nf90_strerror(ierr) 711 stop "getvarup" 712 endif 713 ! WRITE(*,*)'lecture dr ok',dr 714 715 ierr = nf90_get_var(nid, var3didin(29), hr) 716 IF(ierr/=nf90_noerr) THEN 717 WRITE(*, *) nf90_strerror(ierr) 718 stop "getvarup" 719 endif 720 ! WRITE(*,*)'lecture hr ok',hr 721 722 ierr = nf90_get_var(nid, var3didin(30), vr) 723 IF(ierr/=nf90_noerr) THEN 724 WRITE(*, *) nf90_strerror(ierr) 725 stop "getvarup" 726 endif 727 ! WRITE(*,*)'lecture vr ok',vr 728 729 ierr = nf90_get_var(nid, var3didin(31), dtrad) 730 IF(ierr/=nf90_noerr) THEN 731 WRITE(*, *) nf90_strerror(ierr) 732 stop "getvarup" 733 endif 734 ! WRITE(*,*)'lecture dtrad ok',dtrad 735 736 ierr = nf90_get_var(nid, var3didin(32), sens) 737 IF(ierr/=nf90_noerr) THEN 738 WRITE(*, *) nf90_strerror(ierr) 739 stop "getvarup" 740 endif 741 ! WRITE(*,*)'lecture sens ok',sens 742 743 ierr = nf90_get_var(nid, var3didin(33), flat) 744 IF(ierr/=nf90_noerr) THEN 745 WRITE(*, *) nf90_strerror(ierr) 746 stop "getvarup" 747 endif 748 ! WRITE(*,*)'lecture flat ok',flat 749 750 ierr = nf90_get_var(nid, var3didin(34), ts) 751 IF(ierr/=nf90_noerr) THEN 752 WRITE(*, *) nf90_strerror(ierr) 753 stop "getvarup" 754 endif 755 ! WRITE(*,*)'lecture ts ok',ts 756 757 ierr = nf90_get_var(nid, var3didin(35), ustar) 758 IF(ierr/=nf90_noerr) THEN 759 WRITE(*, *) nf90_strerror(ierr) 760 stop "getvarup" 761 endif 762 ! WRITE(*,*)'lecture ustar ok',ustar 763 764 ierr = nf90_get_var(nid, var3didin(36), uw) 765 IF(ierr/=nf90_noerr) THEN 766 WRITE(*, *) nf90_strerror(ierr) 767 stop "getvarup" 768 endif 769 ! WRITE(*,*)'lecture uw ok',uw 770 771 ierr = nf90_get_var(nid, var3didin(37), vw) 772 IF(ierr/=nf90_noerr) THEN 773 WRITE(*, *) nf90_strerror(ierr) 774 stop "getvarup" 775 endif 776 ! WRITE(*,*)'lecture vw ok',vw 777 778 ierr = nf90_get_var(nid, var3didin(38), q1) 779 IF(ierr/=nf90_noerr) THEN 780 WRITE(*, *) nf90_strerror(ierr) 781 stop "getvarup" 782 endif 783 ! WRITE(*,*)'lecture q1 ok',q1 784 785 ierr = nf90_get_var(nid, var3didin(39), q2) 786 IF(ierr/=nf90_noerr) THEN 787 WRITE(*, *) nf90_strerror(ierr) 788 stop "getvarup" 789 endif 790 ! WRITE(*,*)'lecture q2 ok',q2 791 792 END SUBROUTINE read_cas 793 !====================================================================== 794 SUBROUTINE interp_case_time(day, day1, annee_ref & 795 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 796 , nt_cas, nlev_cas & 797 , ts_cas, plev_cas, t_cas, q_cas, u_cas, v_cas & 798 , ug_cas, vg_cas, vitw_cas, du_cas, hu_cas, vu_cas & 799 , dv_cas, hv_cas, vv_cas, dt_cas, ht_cas, vt_cas, dtrad_cas & 800 , dq_cas, hq_cas, vq_cas, lat_cas, sens_cas, ustar_cas & 801 , uw_cas, vw_cas, q1_cas, q2_cas & 802 , ts_prof_cas, plev_prof_cas, t_prof_cas, q_prof_cas & 803 , u_prof_cas, v_prof_cas, ug_prof_cas, vg_prof_cas & 804 , vitw_prof_cas, du_prof_cas, hu_prof_cas, vu_prof_cas & 805 , dv_prof_cas, hv_prof_cas, vv_prof_cas, dt_prof_cas & 806 , ht_prof_cas, vt_prof_cas, dtrad_prof_cas, dq_prof_cas & 807 , hq_prof_cas, vq_prof_cas, lat_prof_cas, sens_prof_cas & 808 , ustar_prof_cas, uw_prof_cas, vw_prof_cas, q1_prof_cas, q2_prof_cas) 809 810 USE lmdz_compar1d 811 USE lmdz_date_cas, ONLY: year_ini_cas, mth_ini_cas, day_deb, heure_ini_cas, pdt_cas, day_ju_ini_cas 812 813 IMPLICIT NONE 814 815 !--------------------------------------------------------------------------------------- 816 ! Time interpolation of a 2D field to the timestep corresponding to day 817 818 ! day: current julian day (e.g. 717538.2) 819 ! day1: first day of the simulation 820 ! nt_cas: total nb of data in the forcing 821 ! pdt_cas: total time interval (in sec) between 2 forcing data 822 !--------------------------------------------------------------------------------------- 823 824 ! inputs: 825 INTEGER annee_ref 826 INTEGER nt_cas, nlev_cas 827 REAL day, day1, day_cas 828 REAL ts_cas(nt_cas) 829 REAL plev_cas(nlev_cas, nt_cas) 830 REAL t_cas(nlev_cas, nt_cas), q_cas(nlev_cas, nt_cas) 831 REAL u_cas(nlev_cas, nt_cas), v_cas(nlev_cas, nt_cas) 832 REAL ug_cas(nlev_cas, nt_cas), vg_cas(nlev_cas, nt_cas) 833 REAL vitw_cas(nlev_cas, nt_cas) 834 REAL du_cas(nlev_cas, nt_cas), hu_cas(nlev_cas, nt_cas), vu_cas(nlev_cas, nt_cas) 835 REAL dv_cas(nlev_cas, nt_cas), hv_cas(nlev_cas, nt_cas), vv_cas(nlev_cas, nt_cas) 836 REAL dt_cas(nlev_cas, nt_cas), ht_cas(nlev_cas, nt_cas), vt_cas(nlev_cas, nt_cas) 837 REAL dtrad_cas(nlev_cas, nt_cas) 838 REAL dq_cas(nlev_cas, nt_cas), hq_cas(nlev_cas, nt_cas), vq_cas(nlev_cas, nt_cas) 839 REAL lat_cas(nt_cas) 840 REAL sens_cas(nt_cas) 841 REAL ustar_cas(nt_cas), uw_cas(nlev_cas, nt_cas), vw_cas(nlev_cas, nt_cas) 842 REAL q1_cas(nlev_cas, nt_cas), q2_cas(nlev_cas, nt_cas) 843 844 ! outputs: 845 REAL plev_prof_cas(nlev_cas) 846 REAL t_prof_cas(nlev_cas), q_prof_cas(nlev_cas) 847 REAL u_prof_cas(nlev_cas), v_prof_cas(nlev_cas) 848 REAL ug_prof_cas(nlev_cas), vg_prof_cas(nlev_cas) 849 REAL vitw_prof_cas(nlev_cas) 850 REAL du_prof_cas(nlev_cas), hu_prof_cas(nlev_cas), vu_prof_cas(nlev_cas) 851 REAL dv_prof_cas(nlev_cas), hv_prof_cas(nlev_cas), vv_prof_cas(nlev_cas) 852 REAL dt_prof_cas(nlev_cas), ht_prof_cas(nlev_cas), vt_prof_cas(nlev_cas) 853 REAL dtrad_prof_cas(nlev_cas) 854 REAL dq_prof_cas(nlev_cas), hq_prof_cas(nlev_cas), vq_prof_cas(nlev_cas) 855 REAL lat_prof_cas, sens_prof_cas, ts_prof_cas, ustar_prof_cas 856 REAL uw_prof_cas(nlev_cas), vw_prof_cas(nlev_cas), q1_prof_cas(nlev_cas), q2_prof_cas(nlev_cas) 857 ! local: 858 INTEGER it_cas1, it_cas2, k 859 REAL timeit, time_cas1, time_cas2, frac 860 861 PRINT*, 'Check time', day1, day_ju_ini_cas, day_deb + 1, pdt_cas 862 863 ! On teste si la date du cas AMMA est correcte. 864 ! C est pour memoire car en fait les fichiers .def 865 ! sont censes etre corrects. 866 ! A supprimer a terme (MPL 20150623) 867 ! if ((forcing_type.EQ.10).AND.(1.EQ.0)) THEN 868 ! Check that initial day of the simulation consistent with AMMA case: 869 ! if (annee_ref.NE.2006) THEN 870 ! PRINT*,'Pour AMMA, annee_ref doit etre 2006' 871 ! PRINT*,'Changer annee_ref dans run.def' 872 ! stop 873 ! endif 874 ! if (annee_ref.EQ.2006 .AND. day1.lt.day_cas) THEN 875 ! PRINT*,'AMMA a debute le 10 juillet 2006',day1,day_cas 876 ! PRINT*,'Changer dayref dans run.def' 877 ! stop 878 ! endif 879 ! if (annee_ref.EQ.2006 .AND. day1.gt.day_cas+1) THEN 880 ! PRINT*,'AMMA a fini le 11 juillet' 881 ! PRINT*,'Changer dayref ou nday dans run.def' 882 ! stop 883 ! endif 884 ! endif 885 886 ! Determine timestep relative to the 1st day: 887 ! timeit=(day-day1)*86400. 888 ! if (annee_ref.EQ.1992) THEN 889 ! timeit=(day-day_cas)*86400. 890 ! else 891 ! timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992 892 ! endif 893 timeit = (day - day_ju_ini_cas) * 86400 894 print *, 'day=', day 895 print *, 'day_ju_ini_cas=', day_ju_ini_cas 896 print *, 'pdt_cas=', pdt_cas 897 print *, 'timeit=', timeit 898 print *, 'nt_cas=', nt_cas 899 900 ! Determine the closest observation times: 901 ! it_cas1=INT(timeit/pdt_cas)+1 902 ! it_cas2=it_cas1 + 1 903 ! time_cas1=(it_cas1-1)*pdt_cas 904 ! time_cas2=(it_cas2-1)*pdt_cas 905 906 it_cas1 = INT(timeit / pdt_cas) + 1 907 IF (it_cas1 == nt_cas) THEN 908 it_cas2 = it_cas1 909 ELSE 910 it_cas2 = it_cas1 + 1 911 ENDIF 912 time_cas1 = (it_cas1 - 1) * pdt_cas 913 time_cas2 = (it_cas2 - 1) * pdt_cas 914 print *, 'it_cas1=', it_cas1 915 print *, 'it_cas2=', it_cas2 916 print *, 'time_cas1=', time_cas1 917 print *, 'time_cas2=', time_cas2 918 919 IF (it_cas1 > nt_cas) THEN 920 WRITE(*, *) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & 921 , day, day_ju_ini_cas, it_cas1, it_cas2, timeit 922 stop 923 endif 924 925 ! time interpolation: 926 IF (it_cas1 == it_cas2) THEN 927 frac = 0. 928 ELSE 929 frac = (time_cas2 - timeit) / (time_cas2 - time_cas1) 930 frac = max(frac, 0.0) 931 ENDIF 932 933 lat_prof_cas = lat_cas(it_cas2) & 934 - frac * (lat_cas(it_cas2) - lat_cas(it_cas1)) 935 sens_prof_cas = sens_cas(it_cas2) & 936 - frac * (sens_cas(it_cas2) - sens_cas(it_cas1)) 937 ts_prof_cas = ts_cas(it_cas2) & 938 - frac * (ts_cas(it_cas2) - ts_cas(it_cas1)) 939 ustar_prof_cas = ustar_cas(it_cas2) & 940 - frac * (ustar_cas(it_cas2) - ustar_cas(it_cas1)) 941 942 DO k = 1, nlev_cas 943 plev_prof_cas(k) = plev_cas(k, it_cas2) & 944 - frac * (plev_cas(k, it_cas2) - plev_cas(k, it_cas1)) 945 t_prof_cas(k) = t_cas(k, it_cas2) & 946 - frac * (t_cas(k, it_cas2) - t_cas(k, it_cas1)) 947 q_prof_cas(k) = q_cas(k, it_cas2) & 948 - frac * (q_cas(k, it_cas2) - q_cas(k, it_cas1)) 949 u_prof_cas(k) = u_cas(k, it_cas2) & 950 - frac * (u_cas(k, it_cas2) - u_cas(k, it_cas1)) 951 v_prof_cas(k) = v_cas(k, it_cas2) & 952 - frac * (v_cas(k, it_cas2) - v_cas(k, it_cas1)) 953 ug_prof_cas(k) = ug_cas(k, it_cas2) & 954 - frac * (ug_cas(k, it_cas2) - ug_cas(k, it_cas1)) 955 vg_prof_cas(k) = vg_cas(k, it_cas2) & 956 - frac * (vg_cas(k, it_cas2) - vg_cas(k, it_cas1)) 957 vitw_prof_cas(k) = vitw_cas(k, it_cas2) & 958 - frac * (vitw_cas(k, it_cas2) - vitw_cas(k, it_cas1)) 959 du_prof_cas(k) = du_cas(k, it_cas2) & 960 - frac * (du_cas(k, it_cas2) - du_cas(k, it_cas1)) 961 hu_prof_cas(k) = hu_cas(k, it_cas2) & 962 - frac * (hu_cas(k, it_cas2) - hu_cas(k, it_cas1)) 963 vu_prof_cas(k) = vu_cas(k, it_cas2) & 964 - frac * (vu_cas(k, it_cas2) - vu_cas(k, it_cas1)) 965 dv_prof_cas(k) = dv_cas(k, it_cas2) & 966 - frac * (dv_cas(k, it_cas2) - dv_cas(k, it_cas1)) 967 hv_prof_cas(k) = hv_cas(k, it_cas2) & 968 - frac * (hv_cas(k, it_cas2) - hv_cas(k, it_cas1)) 969 vv_prof_cas(k) = vv_cas(k, it_cas2) & 970 - frac * (vv_cas(k, it_cas2) - vv_cas(k, it_cas1)) 971 dt_prof_cas(k) = dt_cas(k, it_cas2) & 972 - frac * (dt_cas(k, it_cas2) - dt_cas(k, it_cas1)) 973 ht_prof_cas(k) = ht_cas(k, it_cas2) & 974 - frac * (ht_cas(k, it_cas2) - ht_cas(k, it_cas1)) 975 vt_prof_cas(k) = vt_cas(k, it_cas2) & 976 - frac * (vt_cas(k, it_cas2) - vt_cas(k, it_cas1)) 977 dtrad_prof_cas(k) = dtrad_cas(k, it_cas2) & 978 - frac * (dtrad_cas(k, it_cas2) - dtrad_cas(k, it_cas1)) 979 dq_prof_cas(k) = dq_cas(k, it_cas2) & 980 - frac * (dq_cas(k, it_cas2) - dq_cas(k, it_cas1)) 981 hq_prof_cas(k) = hq_cas(k, it_cas2) & 982 - frac * (hq_cas(k, it_cas2) - hq_cas(k, it_cas1)) 983 vq_prof_cas(k) = vq_cas(k, it_cas2) & 984 - frac * (vq_cas(k, it_cas2) - vq_cas(k, it_cas1)) 985 uw_prof_cas(k) = uw_cas(k, it_cas2) & 986 - frac * (uw_cas(k, it_cas2) - uw_cas(k, it_cas1)) 987 vw_prof_cas(k) = vw_cas(k, it_cas2) & 988 - frac * (vw_cas(k, it_cas2) - vw_cas(k, it_cas1)) 989 q1_prof_cas(k) = q1_cas(k, it_cas2) & 990 - frac * (q1_cas(k, it_cas2) - q1_cas(k, it_cas1)) 991 q2_prof_cas(k) = q2_cas(k, it_cas2) & 992 - frac * (q2_cas(k, it_cas2) - q2_cas(k, it_cas1)) 993 enddo 994 995 RETURN 996 END 997 998 !********************************************************************************************** 1011 999 END MODULE mod_1D_cases_read
Note: See TracChangeset
for help on using the changeset viewer.
