--- trunk/libf/dyn3d/start_init_phys_m.f90 2010/04/01 09:07:28 30 +++ trunk/libf/dyn3d/start_init_phys_m.f90 2011/08/24 11:43:14 49 @@ -5,100 +5,77 @@ IMPLICIT NONE - REAL, ALLOCATABLE, SAVE, DIMENSION(:, :):: qsol_2d - CONTAINS - SUBROUTINE start_init_phys(tsol_2d) + SUBROUTINE start_init_phys(tsol_2d, qsol_2d) - USE flincom, only: flininfo, flinopen_nozoom, flinget, flinclo - use conf_dat2d_m, only: conf_dat2d - use inter_barxy_m, only: inter_barxy - use gr_int_dyn_m, only: gr_int_dyn use comgeom, only: rlonu, rlatv + use conf_dat2d_m, only: conf_dat2d use dimens_m, only: iim, jjm + use gr_int_dyn_m, only: gr_int_dyn + use inter_barxy_m, only: inter_barxy + use jumble, only: find_longitude, find_latitude + use netcdf, only: nf90_nowrite + use netcdf95, only: nf95_open, nf95_close, nf95_get_var, nf95_inq_varid, & + nf95_gw_var + use nr_util, only: assert, pi - REAL, intent(out):: tsol_2d(:, :) - - ! LOCAL - - INTEGER fid_phys, iml_phys, jml_phys - REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys - REAL:: date, dt - REAL, DIMENSION(:), ALLOCATABLE:: levphys_ini - !ac - INTEGER:: itau(1) - INTEGER:: llm_tmp, ttm_tmp + REAL, intent(out):: tsol_2d(:, :), qsol_2d(:, :) ! (iim + 1, jjm + 1) - CHARACTER(len=120) physfname - LOGICAL:: check=.TRUE. + ! Variables local to the procedure: + INTEGER iml_phys, jml_phys, ncid, varid REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:) - REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:) + REAL, pointer:: lon_ini(:), lat_ini(:) ! longitude and latitude in rad REAL, ALLOCATABLE:: var_ana(:, :) real tmp_var(iim, jjm + 1) !----------------------------------- print *, "Call sequence information: start_init_phys" - if (any(shape(tsol_2d) /= (/iim + 1, jjm + 1/))) stop "start_init_phys" - physfname = 'ECPHY.nc' - IF ( check ) print *, 'Opening the surface analysis' - CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys) - - ALLOCATE(lat_phys(iml_phys, jml_phys)) - ALLOCATE(lon_phys(iml_phys, jml_phys)) - ALLOCATE(levphys_ini(llm_tmp)) - - CALL flinopen_nozoom(physfname, iml_phys, jml_phys, & - llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp, & - itau, date, dt, fid_phys) - DEALLOCATE(levphys_ini) + call assert((/size(tsol_2d, 1), size(qsol_2d, 1)/) == iim + 1, & + "start_init_phys 1") + call assert((/size(tsol_2d, 2), size(qsol_2d, 2)/) == jjm + 1, & + "start_init_phys 2") + + call nf95_open('ECPHY.nc', nf90_nowrite, ncid) + + call find_longitude(ncid, varid=varid) + call nf95_gw_var(ncid, varid, lon_ini) + lon_ini = lon_ini * pi / 180. ! convert to rad + iml_phys = size(lon_ini) + + call find_latitude(ncid, varid=varid) + call nf95_gw_var(ncid, varid, lat_ini) + lat_ini = lat_ini * pi / 180. ! convert to rad + jml_phys = size(lat_ini) ! Allocate the space we will need to get the data out of this file ALLOCATE(var_ana(iml_phys, jml_phys)) - ! In case we have a file which is in degrees we do the transformation ALLOCATE(lon_rad(iml_phys)) - ALLOCATE(lon_ini(iml_phys)) - - IF ( MAXVAL(lon_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN - lon_ini(:) = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0 - ELSE - lon_ini(:) = lon_phys(:, 1) - ENDIF - ALLOCATE(lat_rad(jml_phys)) - ALLOCATE(lat_ini(jml_phys)) - IF ( MAXVAL(lat_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN - lat_ini(:) = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0 - ELSE - lat_ini(:) = lat_phys(1, :) - ENDIF - - ! We get the two standard varibales - ! Surface temperature - ! 'ST' : Surface temperature - CALL flinget(fid_phys, 'ST', iml_phys, jml_phys, & - llm_tmp, ttm_tmp, 1, 1, var_ana) + ! We get the two standard variables + ! 'ST': surface temperature + call nf95_inq_varid(ncid, 'ST', varid) + call nf95_get_var(ncid, varid, var_ana) CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana) CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), & rlatv, tmp_var) + tsol_2d = gr_int_dyn(tmp_var) - tsol_2d(:, :) = gr_int_dyn(tmp_var) - - ALLOCATE(qsol_2d(iim + 1, jjm + 1)) ! Soil moisture - CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, & - llm_tmp, ttm_tmp, 1, 1, var_ana) + call nf95_inq_varid(ncid, 'CDSW', varid) + call nf95_get_var(ncid, varid, var_ana) CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana) CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), & rlatv, tmp_var) - qsol_2d(:, :) = gr_int_dyn(tmp_var) + qsol_2d = gr_int_dyn(tmp_var) - CALL flinclo(fid_phys) + call nf95_close(ncid) + deallocate(lon_ini, lat_ini) ! pointers END SUBROUTINE start_init_phys