- Timestamp:
- 11/15/19 10:57:42 (5 years ago)
- Location:
- codes/icosagcm/devel/src
- Files:
-
- 2 added
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/icosa_init.f90
r864 r992 23 23 USE diagflux_mod 24 24 USE profiling_mod 25 USE read_metric_mod 25 26 USE init_grid_param_mod 26 27 USE compute_geometry_mod 28 !USE xios 27 29 IMPLICIT NONE 28 30 … … 43 45 !$OMP PARALLEL 44 46 CALL switch_omp_no_distrib_level 47 CALL read_metric 45 48 CALL compute_geometry 46 49 CALL check_total_area -
codes/icosagcm/devel/src/output/write_etat0.f90
r868 r992 26 26 TYPE(t_field),POINTER,SAVE :: f_ulat(:) 27 27 TYPE(t_field),POINTER,SAVE :: f_theta_rhodz_1d(:) 28 TYPE(t_field),POINTER,SAVE :: f_xcell(:),f_ycell(:),f_zcell(:) 28 29 REAL(rstd), POINTER :: theta_rhodz(:,:,:),theta_rhodz_1d(:,:) 30 REAL(rstd), POINTER :: xcell(:), ycell(:), zcell(:) 29 31 INTEGER :: ind 30 32 … … 34 36 CALL allocate_field(f_ulat,field_t,type_real,llm,name='ulat') 35 37 CALL allocate_field(f_theta_rhodz_1d,field_t,type_real,llm,name='theta_rhodz') 38 CALL allocate_field(f_xcell,field_t,type_real,name='xcell') 39 CALL allocate_field(f_ycell,field_t,type_real,name='ycell') 40 CALL allocate_field(f_zcell,field_t,type_real,name='zcell') 36 41 37 42 !$OMP BARRIER 38 43 DO ind=1, ndomain 39 44 IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 45 CALL swap_dimensions(ind) 46 CALL swap_geometry(ind) 40 47 theta_rhodz=f_theta_rhodz(ind) ; theta_rhodz_1d=f_theta_rhodz_1d(ind) 41 48 theta_rhodz_1d(:,:)=theta_rhodz(:,:,1) 49 xcell=f_xcell(ind) ; xcell=xyz_i(:,1)/radius 50 ycell=f_ycell(ind) ; ycell=xyz_i(:,2)/radius 51 zcell=f_zcell(ind) ; zcell=xyz_i(:,3)/radius 42 52 ENDDO 43 53 … … 46 56 47 57 IF(hydrostatic) THEN 48 CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q )58 CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_xcell, f_ycell, f_zcell ) 49 59 ELSE 50 CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_geopot, f_W )60 CALL write_restart(it,f_ps,f_phis,f_theta_rhodz_1d,f_u, f_ulon, f_ulat, f_q, f_geopot, f_W, f_xcell, f_ycell, f_zcell) 51 61 END IF 52 62 CALL deallocate_field(f_ulon) -
codes/icosagcm/devel/src/output/xios_mod.F90
r922 r992 19 19 20 20 PUBLIC :: using_xios, xios_init, & 21 xios_init_write_field, xios_write_field_finalize, & 21 xios_init_write_field, xios_init_write_field_input, & 22 xios_write_field_finalize, & 22 23 xios_write_field, xios_read_field 23 24 … … 28 29 xios_set_filegroup_attr, xios_get_axis_attr, & 29 30 xios_send_field, xios_read_var, & 30 xios_update_calendar, xios_set_context 31 xios_update_calendar, xios_set_context, xios_set_context_input 31 32 32 33 CONTAINS … … 38 39 using_xios=.TRUE. 39 40 CALL xios_context_initialize("icosagcm",comm_icosa) 40 CALL xios_ get_handle("icosagcm",ctx_hdl)41 CALL xios_set_c urrent_context(ctx_hdl)41 CALL xios_context_initialize("icosagcm_input",comm_icosa) 42 CALL xios_set_context 42 43 43 44 END SUBROUTINE xios_init … … 59 60 TYPE(t_domain),POINTER :: d 60 61 62 CALL xios_set_context 61 63 !$OMP BARRIER 62 64 !$OMP MASTER 63 65 ! CALL xios_context_initialize("icosagcm",comm_icosa) 64 CALL xios_get_handle("icosagcm",ctx_hdl)65 CALL xios_set_current_context(ctx_hdl)66 ! CALL xios_get_handle("icosagcm",ctx_hdl) 67 ! CALL xios_set_current_context(ctx_hdl) 66 68 lev_value(:) = (/ (l,l=1,llm) /) 67 69 lev_valuep1(:) = (/ (l,l=1,llm+1) /) … … 140 142 END SUBROUTINE xios_init_write_field 141 143 144 SUBROUTINE xios_init_write_field_input 145 USE disvert_mod, ONLY : presnivs 146 USE time_mod, ONLY : dt, itau_out 147 USE grid_param, ONLY : llm, nqtot 148 USE mpi_mod, ONLY : MPI_INTEGER 149 USE icosa, ONLY : getin 150 USE mpipara, ONLY : comm_icosa, mpi_rank, mpi_size 151 USE spherical_geom_mod, ONLY : xyz2lonlat 152 USE genmod 153 !USE genmod 154 !USE mpipara 155 !USE xios 156 !USE grid_param 157 !USE domain_mod 158 !USE dimensions 159 !USE spherical_geom_mod 160 !USE geometry 161 !USE mpi_mod 162 !USE time_mod 163 !USE metric, ONLY : vup,vdown, cell_glo 164 !USE icosa,ONLY : getin 165 !IMPLICIT NONE 166 TYPE(xios_context) :: ctx_hdl 167 TYPE(xios_duration) :: dtime 168 INTEGER :: ncell, ncell_tot, ncell_glo(0:mpi_size-1), displ 169 INTEGER :: ind, i,j,k,l,ij, ierr 170 REAL(rstd),ALLOCATABLE :: lon(:), lat(:), bounds_lon(:,:), bounds_lat(:,:) 171 INTEGER, ALLOCATABLE :: ind_glo(:) 172 TYPE(t_domain),POINTER :: d 173 CHARACTER(len=255) :: etat0_type 174 LOGICAL :: read_metric_ 175 176 CALL xios_set_context_input 177 !$OMP BARRIER 178 !$OMP MASTER 179 180 ncell=0 181 DO ind=1,ndomain 182 d=>domain(ind) 183 184 DO j=d%jj_begin,d%jj_end 185 DO i=d%ii_begin,d%ii_end 186 IF (domain(ind)%own(i,j)) ncell=ncell+1 187 ENDDO 188 ENDDO 189 ENDDO 190 ncell_i=ncell 191 192 CALL MPI_ALLGATHER(ncell,1,MPI_INTEGER,ncell_glo,1,MPI_INTEGER,comm_icosa,ierr) 193 194 displ=0 195 DO i=1,mpi_rank 196 displ=displ+ncell_glo(i-1) 197 ENDDO 198 199 ncell_tot=sum(ncell_glo(:)) 200 201 ALLOCATE(lon(ncell), lat(ncell), bounds_lon(0:5,ncell), bounds_lat(0:5,ncell), ind_glo(ncell)) 202 203 ncell=0 204 DO ind=1,ndomain 205 d=>domain(ind) 206 207 DO j=d%jj_begin,d%jj_end 208 DO i=d%ii_begin,d%ii_end 209 IF (domain(ind)%own(i,j)) THEN 210 ncell=ncell+1 211 CALL xyz2lonlat(d%xyz(:,i,j),lon(ncell),lat(ncell)) 212 lon(ncell)=lon(ncell)*180/Pi 213 lat(ncell)=lat(ncell)*180/Pi 214 DO k=0,5 215 CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ncell), bounds_lat(k,ncell)) 216 bounds_lat(k,ncell)=bounds_lat(k,ncell)*180/Pi 217 bounds_lon(k,ncell)=bounds_lon(k,ncell)*180/Pi 218 ENDDO 219 ind_glo(ncell)=domain(ind)%assign_cell_glo(i,j)-1 220 ENDIF 221 ENDDO 222 ENDDO 223 ENDDO 224 225 CALL xios_set_domain_attr("i",ni_glo=ncell_tot, ibegin=displ, ni=ncell) 226 CALL xios_set_domain_attr("i", data_dim=1, type='unstructured' , nvertex=6, i_index=ind_glo) 227 CALL xios_set_domain_attr("i",lonvalue_1d=lon, latvalue_1d=lat, bounds_lon_1d=bounds_lon, bounds_lat_1d=bounds_lat) 228 229 DEALLOCATE(lon, lat, bounds_lon, bounds_lat,ind_glo) 230 231 dtime%second=1 232 CALL xios_set_timestep(dtime) 233 !$OMP END MASTER 234 235 CALL getin('etat0',etat0_type) 236 CALL getin('read_metric', read_metric_) 237 238 !$OMP MASTER 239 240 CALL xios_set_file_attr('start', enabled=.FALSE.) 241 IF (TRIM(etat0_type)=='start_file' .AND. read_metric_) THEN 242 CALL xios_set_file_attr('start', enabled=.TRUE.) 243 ENDIF 244 245 246 CALL xios_close_context_definition() 247 !$OMP END MASTER 248 !$OMP BARRIER 249 250 END SUBROUTINE xios_init_write_field_input 251 252 253 142 254 SUBROUTINE xios_write_field(name,field) 143 255 CHARACTER(LEN=*),INTENT(IN) :: name … … 172 284 173 285 END SUBROUTINE xios_write_field 286 287 174 288 175 289 SUBROUTINE xios_read_field(name,field) … … 258 372 SUBROUTINE xios_read_field_hex(name, field, cells, ncell_tot, nlev, nq) 259 373 CHARACTER(LEN=*),INTENT(IN) :: name 260 TYPE(t_field) :: field(:)374 TYPE(t_field), POINTER :: field(:) 261 375 TYPE(t_cellset), TARGET :: cells(:) 262 376 INTEGER,INTENT(IN) :: ncell_tot, nlev, nq … … 275 389 sgn=1 276 390 END IF 391 277 392 278 393 n_beg=0 … … 324 439 END SUBROUTINE xios_set_context 325 440 441 SUBROUTINE xios_set_context_input 442 IMPLICIT NONE 443 TYPE(xios_context) :: ctx_hdl 444 445 !$OMP MASTER 446 CALL xios_get_handle("icosagcm_input",ctx_hdl) 447 CALL xios_set_current_context(ctx_hdl) 448 !$OMP END MASTER 449 450 END SUBROUTINE xios_set_context_input 326 451 327 452 #else … … 376 501 END SUBROUTINE xios_write_field_finalize 377 502 503 SUBROUTINE xios_init_write_field_input 504 END SUBROUTINE 505 378 506 SUBROUTINE xios_init_write_field 379 507 END SUBROUTINE xios_init_write_field
Note: See TracChangeset
for help on using the changeset viewer.