Changeset 883 for codes/icosagcm/devel/src
- Timestamp:
- 06/11/19 17:38:17 (5 years ago)
- Location:
- codes/icosagcm/devel/src
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/base/field.f90
r879 r883 1 1 MODULE field_mod 2 2 USE genmod 3 USE grid_param 4 3 5 IMPLICIT NONE 4 6 … … 44 46 END INTERFACE 45 47 46 PRIVATE :: allocate_field_, deallocate_field_ 48 ! This module is PUBLIC, we do not want to propagate symbols from modules USEd at module level 49 PRIVATE :: allocate_field_, deallocate_field_, grid_type, grid_unst, grid_ico 47 50 48 51 CONTAINS … … 150 153 SUBROUTINE allocate_field_XvalY(field, dom) 151 154 USE domain_mod, ONLY : t_domain 152 USE grid_param153 155 TYPE(t_field) :: field 154 156 TYPE(t_domain), INTENT(IN) :: dom … … 184 186 185 187 CASE(grid_unst) 186 PRINT *, 'Allocating field ', field%name187 188 SELECT CASE(field%field_type) 188 189 CASE(field_T) … … 194 195 END SELECT 195 196 196 PRINT *, 'Allocating field ', field%name197 PRINT *, ' with ij_size = ', ij_size198 197 199 198 IF (field%ndim==4) THEN 199 PRINT *, 'Allocating field ', TRIM(field%name), ' with shape = ', dim1, ij_size, dim2 200 200 IF (data_type==type_integer) ALLOCATE(field%ival4d(dim1,ij_size,dim2)) 201 201 IF (data_type==type_real) ALLOCATE(field%rval4d(dim1,ij_size,dim2)) 202 202 IF (data_type==type_logical) ALLOCATE(field%lval4d(dim1,ij_size,dim2)) 203 203 ELSE IF (field%ndim==3) THEN 204 PRINT *, 'Allocating field ', TRIM(field%name), ' with shape = ', dim1, ij_size 204 205 IF (data_type==type_integer) ALLOCATE(field%ival3d(dim1,ij_size)) 205 206 IF (data_type==type_real) ALLOCATE(field%rval3d(dim1,ij_size)) 206 207 IF (data_type==type_logical) ALLOCATE(field%lval3d(dim1,ij_size)) 207 208 ELSE IF (field%ndim==2) THEN 209 PRINT *, 'Allocating field ', TRIM(field%name), ' with shape = ', ij_size 208 210 IF (data_type==type_integer) ALLOCATE(field%ival2d(ij_size)) 209 211 IF (data_type==type_real) ALLOCATE(field%rval2d(ij_size)) … … 362 364 END IF 363 365 field_pt=>field%rval2d 366 IF(grid_type == grid_unst) THEN 367 PRINT *, 'getval_r2d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt) 368 END IF 364 369 END SUBROUTINE getval_r2d 365 370 … … 375 380 END IF 376 381 field_pt=>field%rval3d 382 IF(grid_type == grid_unst) THEN 383 PRINT *, 'getval_r3d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt) 384 END IF 377 385 END SUBROUTINE getval_r3d 378 386 … … 387 395 END IF 388 396 field_pt=>field%rval4d 397 IF(grid_type == grid_unst) THEN 398 PRINT *, 'getval_r4d for ' // TRIM(field%name) // ' : ', SHAPE(field_pt) 399 END IF 389 400 END SUBROUTINE getval_r4d 390 401 -
codes/icosagcm/devel/src/base/math_const.f90
r533 r883 2 2 USE PREC 3 3 4 REAL(rstd), PARAMETER :: Pi=acos(-1._rstd)4 REAL(rstd), PARAMETER :: Pi=acos(-1._rstd), radian_to_degree=180._rstd/Pi 5 5 COMPLEX(cstd), PARAMETER :: Imag=(0,1) 6 6 -
codes/icosagcm/devel/src/output/output_field.f90
r856 r883 36 36 37 37 IF (xios_output) THEN 38 IF(grid_type == grid_ico)CALL xios_init_write_field38 CALL xios_init_write_field 39 39 ENDIF 40 40 END SUBROUTINE output_field_init -
codes/icosagcm/devel/src/output/write_field.f90
r880 r883 175 175 DO n=1, cells(ind)%ncell 176 176 ij=cells(ind)%ij(n) 177 PRINT *, 'write_2d :', ind, n, n_begin+n, ij178 177 field_val2d(n_begin+n) = field(ind)%rval2d(ij) 179 178 END DO -
codes/icosagcm/devel/src/unstructured/init_unstructured.f90
r879 r883 1 1 MODULE init_unstructured_mod 2 USE prec, ONLY : rstd 3 USE math_const, ONLY : radian_to_degree 2 4 USE mpipara, ONLY : is_mpi_master 3 5 USE data_unstructured_mod … … 95 97 END SUBROUTINE read_from_gridfile 96 98 97 98 99 SUBROUTINE open_local_mesh_file 99 100 USE netcdf_mod … … 153 154 END SUBROUTINE read_field 154 155 156 157 SUBROUTINE setup_cellset(set, lon, lat) 158 USE domain_mod, ONLY : t_cellset 159 TYPE(t_cellset) :: set 160 REAL(rstd) :: lon(:), lat(:) 161 INTEGER :: ij 162 set%ncell = SIZE(lon) 163 ALLOCATE(set%lon, SOURCE=lon*radian_to_degree) 164 ALLOCATE(set%lat, SOURCE=lat*radian_to_degree) 165 ALLOCATE(set%ij, SOURCE = (/(ij,ij=1,set%ncell)/)) 166 ALLOCATE(set%ind_glo, SOURCE = set%ij(:)-1) 167 END SUBROUTINE setup_cellset 168 169 SUBROUTINE read_local_mesh_bounds(dom) 170 USE domain_mod, ONLY : t_domain 171 USE geometry, ONLY : lon_i, lat_i, lon_e, lat_e 172 TYPE(t_domain), INTENT(IN) :: dom 173 REAL(rstd) :: bounds_e(2,edge_num) 174 REAL(rstd), ALLOCATABLE :: lon_v(:), lat_v(:) 175 INTEGER :: ij, vup, vdown 176 177 ! read dual cell positions, not stored in geom 178 CALL read_from_gridfile(id_nc, 'float', 'lon_v') 179 ALLOCATE(lon_v, SOURCE=Ddata_read1) 180 CALL read_from_gridfile(id_nc, 'float', 'lat_v') 181 ALLOCATE(lat_v, SOURCE=Ddata_read1) 182 183 CALL setup_cellset(dom%primal_own, lon_i, lat_i) 184 CALL setup_cellset(dom%dual_own, lon_v, lat_v) 185 CALL setup_cellset(dom%edge_own, lon_e, lat_e) 186 187 PRINT *, 'read_local_mesh :', primal_num, SHAPE(dom%primal_own%ij) 188 189 ! read primal cell bounds 190 CALL read_from_gridfile(id_nc, 'float', 'primal_bounds_lon') 191 ALLOCATE(dom%primal_own%bnds_lon, source=Ddata_read2*radian_to_degree) 192 CALL read_from_gridfile(id_nc, 'float', 'primal_bounds_lat') 193 ALLOCATE(dom%primal_own%bnds_lat, source=Ddata_read2*radian_to_degree) 194 ! read dual cell bounds 195 CALL read_from_gridfile(id_nc, 'float', 'dual_bounds_lon') 196 ALLOCATE(dom%dual_own%bnds_lon, source=Ddata_read2*radian_to_degree) 197 CALL read_from_gridfile(id_nc, 'float', 'dual_bounds_lat') 198 ALLOCATE(dom%dual_own%bnds_lat, source=Ddata_read2*radian_to_degree) 199 200 CALL collect_lonlat_e(lat_v) 201 ALLOCATE(dom%edge_own%bnds_lat, SOURCE=bounds_e) 202 CALL collect_lonlat_e(lon_v) 203 ALLOCATE(dom%edge_own%bnds_lon, SOURCE=bounds_e) 204 205 CONTAINS 206 SUBROUTINE collect_lonlat_e(lonlat) 207 REAL(rstd) :: lonlat(dual_num) 208 DO ij=1, edge_num 209 vdown = down(ij) 210 vup = up(ij) 211 bounds_e(1,ij) = lonlat(vdown)*radian_to_degree 212 bounds_e(2,ij) = lonlat(vup)*radian_to_degree 213 END DO 214 END SUBROUTINE collect_lonlat_e 215 216 END SUBROUTINE read_local_mesh_bounds 217 155 218 SUBROUTINE read_local_mesh 156 219 USE field_mod 220 USE domain_mod, ONLY : swap_needed, domain, domain_glo 157 221 USE geometry, ONLY : geom, lon_i, lat_i, lon_e, lat_e, ep_e 158 USE domain_mod, ONLY : domain, domain_glo, t_domain, swap_needed222 USE netcdf_mod, ONLY : nf90_close 159 223 IMPLICIT NONE 160 INTEGER :: ij 224 INTEGER :: ij, ierr 161 225 INTEGER, ALLOCATABLE :: cell_ij(:) 162 226 REAL(rstd), ALLOCATABLE :: angle_e(:) … … 178 242 swap_needed = .TRUE. 179 243 CALL swap_geometry(1) 180 181 ! cell centers and bounds are read into domain(1)%primal_own 182 domain(1)%primal_own%ncell = primal_num 183 domain_glo(1)%primal_own%ncell = primal_num 184 ALLOCATE(domain(1)%primal_own%lon, source=lon_i) 185 ALLOCATE(domain_glo(1)%primal_own%lon, source=lon_i) 186 ALLOCATE(domain(1)%primal_own%lat, source=lat_i) 187 ALLOCATE(domain_glo(1)%primal_own%lat, source=lat_i) 188 189 CALL read_from_gridfile(id_nc, 'float', 'primal_bounds_lon') 190 ALLOCATE(domain(1)%primal_own%bnds_lon, source=Ddata_read2) 191 ALLOCATE(domain_glo(1)%primal_own%bnds_lon, source=Ddata_read2) 192 CALL read_from_gridfile(id_nc, 'float', 'primal_bounds_lat') 193 ALLOCATE(domain(1)%primal_own%bnds_lat, source=Ddata_read2) 194 ALLOCATE(domain_glo(1)%primal_own%bnds_lat, source=Ddata_read2) 244 195 245 PRINT *, 'read_local_mesh : primal_num =', primal_num, domain_glo(1)%primal_own%ncell 196 246 … … 234 284 ALLOCATE(wee, source = Ddata_read2) 235 285 286 ! read cell centers and bounds 287 CALL read_local_mesh_bounds(domain(1)) 288 CALL read_local_mesh_bounds(domain_glo(1)) 289 236 290 CALL free_data_read ! free buffers after reading all data from grid file 237 238 239 ! edge_num = SIZE(le_de) 240 ! primal_num = SIZE(Ai) 241 ! dual_num = SIZE(Av) 291 ierr = nf90_close(id_nc) 292 293 ! now process some of the data we just read 294 242 295 max_primal_deg = SIZE(primal_edge,1) 243 296 max_dual_deg = SIZE(dual_edge,1) 244 297 max_trisk_deg = SIZE(trisk,1) 245 298 246 ! now post-process some of the data we just read247 ALLOCATE(ep_e(edge_num,3))248 299 DO ij=1,edge_num 249 300 clon = COS(lon_e(ij)) … … 254 305 elon = (/ -slon, clon, 0. /) 255 306 elat = (/ -slat*clon, -slat*slon, clat /) 256 ep_e( ij,:) = COS(angle_e(ij))*elon + SIN(angle_e(ij))*elat307 ep_e(:,ij) = COS(angle_e(ij))*elon + SIN(angle_e(ij))*elat 257 308 END DO 258 309 259 310 DEALLOCATE(angle_e) 260 311 261 ALLOCATE(domain(1)%primal_own%ij(primal_num))262 domain(1)%primal_own%ij(:) = (/(ij,ij=1,primal_num)/)263 PRINT *, 'read_local_mesh :', SHAPE(domain), primal_num, &264 SHAPE(domain(1)%primal_own%ij)265 266 ALLOCATE(cell_ij(dual_num))267 cell_ij(:) = (/(ij,ij=1,dual_num)/)268 ALLOCATE(domain(1)%dual_own%ij, source=cell_ij)269 DEALLOCATE(cell_ij)270 271 312 CALL swap_geometry(1) 272 313 swap_needed = .FALSE. 314 273 315 END SUBROUTINE read_local_mesh 274 316
Note: See TracChangeset
for help on using the changeset viewer.